An interpreted, lazy lisp.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

155 lines
5.1 KiB

||| Module Parser defines a parser for the Rose language.
module Rose.Parser
import Text.Parser
import Text.Parser.Core
import Lexer
import Text.Lexer
import Data.Atom
import Data.SExpression
import Data.Form
reservedWords : List String
reservedWords = ["let", "def", "macro", "fn", "where"]
checkReserved : Rule SE -> Rule SE
checkReserved r = join $ pure isReserved <*> r
where isReserved : SE -> Grammar ParsedToken False SE
isReserved (MkAtom (MkSymbol name)) = if (not $ name `elem` reservedWords)
then pure $ MkAtom (MkSymbol name)
else (fail (ReservedWord name))
isReserved x = pure x
ReservedWord : String -> String
ReservedWord word =
"The symbol " ++ word ++ " is reserved. Use a different symbol, such as x."
reserved : String -> Rule SE
reserved s = terminal
(\x => case (tok x) of
(TkSymbol s') => if s == s' then (Just $ MkAtom (MkSymbol s)) else Nothing
_ => Nothing)
manyEnclosed : Rule ty -> Rule (List ty)
manyEnclosed r = (lparen *> manyTill rparen r)
<|> (lbrack *> manyTill rbrack r)
someEnclosed : Rule ty -> Rule (List ty)
someEnclosed r = (lparen *> someTill rparen r)
<|> (lbrack *> someTill rbrack r)
enclosed : Grammar ParsedToken t ty -> Rule ty
enclosed r =
(between lbrack rbrack r) <|> (between lparen rparen r)
mutual
||| Let forms
||| (let [binding value...] body)
export
lett : Rule SE
lett =
enclosed
$ reserved "let"
*> manyEnclosed bindings
>>= \bs => (atoms <|> expression)
>>= \body => pure $ fromList (bs ++ [body])
where bindings : Rule SE
bindings =
checkReserved symbol
>>= \binding => (atoms <|> expression) </> UnevenLetBindings binding
>>= \value => pure $ (Expression binding value)
UnevenLetBindings : SE -> String
UnevenLetBindings binding =
"Uneven let bindings. Let bindings must contain an even number of names and values: (let [binding value] body)"
++ "\n\t"
++ "The binding " ++ show binding ++ " should be followed by a value or expression."
||| Where forms
||| (where x (fn [] 2)
||| y 2)
export
wheref : Rule SE
wheref =
lparen
*> reserved "where"
*> manyTill rparen bindings
>>= \bs => pure $ fromList bs
where bindings : Rule SE
bindings =
checkReserved symbol
>>= \name => (fn <|> macro <|> app <|> atoms) </> UnevenWhereBindings name
>>= \value => pure $ Expression name value
UnevenWhereBindings : SE -> String
UnevenWhereBindings binding =
"Uneven where bindings. Where bindings must contain an even number of names and values: (where binding value...)"
++ "\n\t"
++ "The binding " ++ show binding ++ " should be followed by a value or expression."
||| Anonymous macros
||| (macro [x] foo)
export
macro : Rule SE
macro =
enclosed
$ reserved "macro"
*> pattern
where pattern : Rule SE
pattern =
pure fromList
<*> manyEnclosed (checkReserved atoms) </> MissingMacroArgList
>>= \args => (atoms <|> macro <|> expression) </> MissingMacroBody args
>>= \body => pure $ (Expression args body)
MissingMacroArgList : String
MissingMacroArgList =
"Expected a list of arguments or pattern matches."
++ "\n\t"
++ "Macros take an even number of argument lists and bodies."
MissingMacroBody : SE -> String
MissingMacroBody pat =
"Missing macro body. Macros must contain an argument list and function body: (macro [x] 1)"
++ "\n\t"
++ "The arguments " ++ show pat ++ " should be followed by a function body."
app : Rule SE
app =
enclosed
$ (symbol <|> fn <|> macro)
>>= \f => many (atoms <|> expression)
>>= \args => pure $ Expression f (fromList args)
||| Anonymous functions
||| (fn [0] 1
||| [n] (- n 1))
export
fn : Rule SE
fn =
enclosed
$ reserved "fn"
*> many patterns
>>= \pats => pure $ fromList pats
where patterns =
manyEnclosed atoms
>>= \args => (atoms <|> lett <|> fn <|> app) </> InvalidFunctionBody args
>>= \body => pure $ (Expression (fromList args) body)
InvalidFunctionBody : (List SE) -> String
InvalidFunctionBody args =
"Invalid function body. Functions must contain an argument list and function body: (fn [x] 1)"
++ "\n\t"
++ "The arguments " ++ show args ++ " should be followed by a function body."
export
def : Rule SE
def =
enclosed
$ reserved "def"
*> symbol
>>= \name => (atoms <|> expression) </> MissingDefinitionBody
>>= \body => pure $ Expression name body
where MissingDefinitionBody : String
MissingDefinitionBody = "Expected a definition body."
||| A program is a list of s-expressions
export
program : Grammar ParsedToken False (List SE)
program =
manyTill eof list