add operators
This commit is contained in:
@@ -19,6 +19,12 @@ TokenList = List BTok
|
||||
public export
|
||||
data Fixity = InfixL | InfixR | Infix
|
||||
|
||||
export
|
||||
Show Fixity where
|
||||
show InfixL = "infixl"
|
||||
show InfixR = "infixr"
|
||||
show Infix = "infix"
|
||||
|
||||
-- I was going to use a record, but we're peeling this off of bounds at the moment.
|
||||
public export
|
||||
FC : Type
|
||||
@@ -54,27 +60,32 @@ showError src (E (line, col) msg) = "ERROR at \{show (line,col)}: \{msg}\n" ++ g
|
||||
-- Result of a parse
|
||||
public export
|
||||
data Result : Type -> Type where
|
||||
OK : a -> (toks : TokenList) -> (com : Bool) -> Result a
|
||||
Fail : Bool -> Error -> (toks : TokenList) -> (com : Bool) -> Result a
|
||||
OK : a -> (toks : TokenList) -> (com : Bool) -> List (String, Int, Fixity) -> Result a
|
||||
Fail : Bool -> Error -> (toks : TokenList) -> (com : Bool) -> List (String, Int, Fixity) -> Result a
|
||||
|
||||
export
|
||||
Functor Result where
|
||||
map f (OK a toks com ) = OK (f a) toks com
|
||||
map _ (Fail fatal err toks com) = Fail fatal err toks com
|
||||
map f (OK a toks com ops) = OK (f a) toks com ops
|
||||
map _ (Fail fatal err toks com ops) = Fail fatal err toks com ops
|
||||
|
||||
-- So sixty just has a newtype function here now (probably for perf).
|
||||
-- A record might be more ergonomic, but would require a record impl before
|
||||
-- self hosting.
|
||||
|
||||
-- We keep the line and column for indents. The idea being that we check
|
||||
-- FC is a line and column for indents. The idea being that we check
|
||||
-- either the col < tokCol or line == tokLine, enabling sameLevel.
|
||||
|
||||
-- dunno why I'm making that a pair..
|
||||
export
|
||||
data Parser a = P (TokenList -> Bool -> (lc : FC) -> Result a)
|
||||
-- This is a Reader in FC
|
||||
|
||||
-- we need State for operators (or postpone that to elaboration)
|
||||
-- Since I've already built out the pratt stuff, I guess I'll
|
||||
-- leave it in the parser for now
|
||||
|
||||
export
|
||||
runP : Parser a -> TokenList -> Bool -> FC -> Result a
|
||||
data Parser a = P (TokenList -> Bool -> List (String, Int, Fixity) -> (lc : FC) -> Result a)
|
||||
|
||||
export
|
||||
runP : Parser a -> TokenList -> Bool -> List (String, Int, Fixity) -> FC -> Result a
|
||||
runP (P f) = f
|
||||
|
||||
error : TokenList -> String -> Error
|
||||
@@ -83,71 +94,80 @@ error ((MkBounded val isIrrelevant (MkBounds line col _ _)) :: _) msg = E (line,
|
||||
|
||||
export
|
||||
parse : Parser a -> TokenList -> Either Error a
|
||||
parse pa toks = case runP pa toks False (-1,-1) of
|
||||
Fail fatal err toks com => Left err
|
||||
OK a [] _ => Right a
|
||||
OK a ts _ => Left (error ts "Extra toks")
|
||||
parse pa toks = case runP pa toks False [] (-1,-1) of
|
||||
Fail fatal err toks com ops => Left err
|
||||
OK a [] _ _ => Right a
|
||||
OK a ts _ _ => Left (error ts "Extra toks")
|
||||
|
||||
-- I think I want to drop the typeclasses for v1
|
||||
|
||||
export
|
||||
fail : String -> Parser a
|
||||
fail msg = P $ \toks,com,col => Fail False (error toks msg) toks com
|
||||
fail msg = P $ \toks,com,ops,col => Fail False (error toks msg) toks com ops
|
||||
|
||||
export
|
||||
fatal : String -> Parser a
|
||||
fatal msg = P $ \toks,com,col => Fail False (error toks msg) toks com
|
||||
fatal msg = P $ \toks,com,ops,col => Fail True (error toks msg) toks com ops
|
||||
|
||||
-- mustWork / commit copied from Idris, but I may switch to the parsec consumption thing.
|
||||
export
|
||||
mustWork : Parser a -> Parser a
|
||||
mustWork (P pa) = P $ \ toks, com, col => case (pa toks com col) of
|
||||
Fail x err xs y => Fail True err xs y
|
||||
mustWork (P pa) = P $ \ toks, com, ops, col => case (pa toks com ops col) of
|
||||
Fail x err xs y ops => Fail True err xs y ops
|
||||
res => res
|
||||
|
||||
export
|
||||
getOps : Parser (List (String, Int, Fixity))
|
||||
getOps = P $ \ toks, com, ops, col => OK ops toks com ops
|
||||
|
||||
export
|
||||
addOp : String -> Int -> Fixity -> Parser ()
|
||||
addOp nm prec fix = P $ \ toks, com, ops, col =>
|
||||
OK () toks com ((nm, prec, fix) :: ops)
|
||||
|
||||
export
|
||||
Functor Parser where
|
||||
map f (P pa) = P $ \ toks, com, col => map f (pa toks com col)
|
||||
map f (P pa) = P $ \ toks, com, ops, col => map f (pa toks com ops col)
|
||||
|
||||
export
|
||||
Applicative Parser where
|
||||
pure pa = P (\ toks, com, col => OK pa toks com)
|
||||
P pab <*> P pa = P $ \toks,com,col =>
|
||||
case pab toks com col of
|
||||
Fail fatal err toks com => Fail fatal err toks com
|
||||
OK f toks com =>
|
||||
case pa toks com col of
|
||||
(OK x toks com) => OK (f x) toks com
|
||||
(Fail fatal err toks com) => Fail fatal err toks com
|
||||
pure pa = P (\ toks, com, ops, col => OK pa toks com ops)
|
||||
P pab <*> P pa = P $ \toks,com,ops,col =>
|
||||
case pab toks com ops col of
|
||||
Fail fatal err toks com ops => Fail fatal err toks com ops
|
||||
OK f toks com ops =>
|
||||
case pa toks com ops col of
|
||||
(OK x toks com ops) => OK (f x) toks com ops
|
||||
(Fail fatal err toks com ops) => Fail fatal err toks com ops
|
||||
|
||||
-- REVIEW it would be nice if the second argument was lazy...
|
||||
export
|
||||
(<|>) : Parser a -> Lazy (Parser a) -> Parser a
|
||||
(P pa) <|> (P pb) = P $ \toks,com,col =>
|
||||
case pa toks False col of
|
||||
OK a toks' _ => OK a toks' com
|
||||
Fail True err toks' com => Fail True err toks' com
|
||||
Fail fatal err toks' True => Fail fatal err toks' com
|
||||
Fail fatal err toks' False => pb toks com col
|
||||
(P pa) <|> (P pb) = P $ \toks,com,ops,col =>
|
||||
case pa toks False ops col of
|
||||
OK a toks' _ ops => OK a toks' com ops
|
||||
Fail True err toks' com ops => Fail True err toks' com ops
|
||||
Fail fatal err toks' True ops => Fail fatal err toks' com ops
|
||||
Fail fatal err toks' False ops => pb toks com ops col
|
||||
|
||||
export
|
||||
Monad Parser where
|
||||
P pa >>= pab = P $ \toks,com,col =>
|
||||
case pa toks com col of
|
||||
(OK a toks com) => runP (pab a) toks com col
|
||||
(Fail fatal err xs x) => Fail fatal err xs x
|
||||
P pa >>= pab = P $ \toks,com,ops,col =>
|
||||
case pa toks com ops col of
|
||||
(OK a toks com ops) => runP (pab a) toks com ops col
|
||||
(Fail fatal err xs x ops) => Fail fatal err xs x ops
|
||||
|
||||
|
||||
-- do we need this?
|
||||
pred : (BTok -> Bool) -> String -> Parser String
|
||||
pred f msg = P $ \toks,com,col =>
|
||||
pred f msg = P $ \toks,com,ops,col =>
|
||||
case toks of
|
||||
(t :: ts) => if f t then OK (value t) ts com else Fail False (error toks "\{msg} at \{show $ kind t}:\{value t}") toks com
|
||||
[] => Fail False (error toks "\{msg} at EOF") toks com
|
||||
(t :: ts) => if f t then OK (value t) ts com ops else Fail False (error toks "\{msg} at \{show $ kind t}:\{value t}") toks com ops
|
||||
[] => Fail False (error toks "\{msg} at EOF") toks com ops
|
||||
|
||||
export
|
||||
commit : Parser ()
|
||||
commit = P $ \toks,com,col => OK () toks True
|
||||
commit = P $ \toks,com,ops,col => OK () toks True ops
|
||||
|
||||
mutual
|
||||
export some : Parser a -> Parser (List a)
|
||||
@@ -164,32 +184,31 @@ mutual
|
||||
-- withIndentationBlock - sets the col
|
||||
export
|
||||
getPos : Parser FC
|
||||
getPos = P $ \toks,com, (l,c) => case toks of
|
||||
[] => OK emptyFC toks com
|
||||
(t :: ts) => OK (start t) toks com
|
||||
getPos = P $ \toks,com, ops, (l,c) => case toks of
|
||||
[] => OK emptyFC toks com ops
|
||||
(t :: ts) => OK (start t) toks com ops
|
||||
|
||||
||| Start an indented block and run parser in it
|
||||
export
|
||||
startBlock : Parser a -> Parser a
|
||||
startBlock (P p) = P $ \toks,com,(l,c) => case toks of
|
||||
[] => p toks com (l,c)
|
||||
startBlock (P p) = P $ \toks,com,ops,(l,c) => case toks of
|
||||
[] => p toks com ops (l,c)
|
||||
(t :: _) =>
|
||||
-- If next token is at or before the current level, we've got an empty block
|
||||
let (tl,tc) = start t
|
||||
in p toks com (tl,ifThenElse (tc <= c) (c + 1) tc)
|
||||
-- in p toks com (tl,tc)
|
||||
in p toks com ops (tl,ifThenElse (tc <= c) (c + 1) tc)
|
||||
|
||||
||| Assert that parser starts at our current column by
|
||||
||| checking column and then updating line to match the current
|
||||
export
|
||||
sameLevel : Parser a -> Parser a
|
||||
sameLevel (P p) = P $ \toks,com,(l,c) => case toks of
|
||||
[] => p toks com (l,c)
|
||||
sameLevel (P p) = P $ \toks,com,ops,(l,c) => case toks of
|
||||
[] => p toks com ops (l,c)
|
||||
(t :: _) =>
|
||||
let (tl,tc) = start t
|
||||
in if tc == c then p toks com (tl, c)
|
||||
else if c < tc then Fail False (error toks "unexpected indent") toks com
|
||||
else Fail False (error toks "unexpected indent") toks com
|
||||
in if tc == c then p toks com ops (tl, c)
|
||||
else if c < tc then Fail False (error toks "unexpected indent") toks com ops
|
||||
else Fail False (error toks "unexpected indent") toks com ops
|
||||
|
||||
export
|
||||
someSame : Parser a -> Parser (List a)
|
||||
@@ -202,12 +221,12 @@ manySame pa = many $ sameLevel pa
|
||||
||| requires a token to be indented?
|
||||
export
|
||||
indented : Parser a -> Parser a
|
||||
indented (P p) = P $ \toks,com,(l,c) => case toks of
|
||||
[] => p toks com (l,c)
|
||||
indented (P p) = P $ \toks,com,ops,(l,c) => case toks of
|
||||
[] => p toks com ops (l,c)
|
||||
(t::_) =>
|
||||
let (tl,tc) = start t
|
||||
in if tc > c || tl == l then p toks com (l,c)
|
||||
else Fail False (error toks "unexpected outdent") toks com
|
||||
in if tc > c || tl == l then p toks com ops (l,c)
|
||||
else Fail False (error toks "unexpected outdent") toks com ops
|
||||
|
||||
export
|
||||
token' : Kind -> Parser String
|
||||
|
||||
Reference in New Issue
Block a user