Call's LHS takes an AST; parse record access with op/

This commit is contained in:
darkf 2013-10-28 20:23:29 -07:00
parent 07a89daec1
commit 203c908f7f
3 changed files with 32 additions and 18 deletions

3
ast.hs
View File

@ -18,7 +18,8 @@ data AST = Add AST AST
| Def Pattern AST
| Var String
| Lambda [(Pattern, AST)]
| Call String AST
| Call AST AST
| Access AST AST
| UnitConst
| Cons AST AST
| IfExpr AST AST AST

View File

@ -272,17 +272,19 @@ eval (NotEquals l r) = do { l <- eval l; r <- eval r; return $ l !=$ r }
eval (LessThan l r) = do { l <- eval l; r <- eval r; return $ l <$ r }
eval (GreaterThan l r) = do { l <- eval l; r <- eval r; return $ l >$ r }
eval (Call name arg) = get >>= \(h,env) ->
case lookup env name of
Just fn@(FnV cls _) -> do
eval (Call lhs arg) = do
(h,env) <- get
v <- eval lhs
case v of
fn@(FnV cls _) -> do
arg' <- eval arg
let cls' = if cls == [] then [last env] else cls -- if [], use current global env
put (h,cls') -- enter closure env
v <- apply fn arg'
put (h,env) -- restore env
return v
Just fn@(Builtin _) -> eval arg >>= apply fn
Nothing -> error $ "call: name " ++ name ++ " doesn't exist or is not a function"
fn@(Builtin _) -> eval arg >>= apply fn
_ -> error $ "call: " ++ show v ++ " is not a function"
eval x = error $ "eval: unhandled: " ++ show x

View File

@ -128,20 +128,20 @@ lambda = do
body <- exprparser
return $ Lambda [(pat, body)]
call = do
name <- identifier
call p argp = do
lhs <- p
whiteSpace
symbol "("
args <- sepBy exprparser (symbol ",")
args <- sepBy argp (symbol ",")
let arg = (case args of
[] -> UnitConst
[a] -> a
otherwise -> TupleConst args)
symbol ")"
return $ Call name arg
return $ Call lhs arg
consExpr = do
x <- expr'
x <- expr3
symbol "::"
y <- exprparser
return $ Cons x y
@ -164,14 +164,18 @@ def = do
value <- exprparser
return $ Def pat value
expr' = try block
<|> try funDef
<|> try call
-- field access
accessOp = do
symbol "/"
return Access
expr1 = try block
<|> try lambda
-- <|> try funDef
<|> try def
<|> try (emptyTuple TupleConst)
<|> try (tupleSeq exprparser TupleConst)
<|> parens exprparser
-- <|> try (emptyTuple TupleConst)
-- <|> try (tupleSeq exprparser TupleConst)
-- <|> parens exprparser
<|> listSeq exprparser ListConst
<|> try ifExpr
<|> try bool
@ -179,8 +183,15 @@ expr' = try block
<|> fmap StrConst stringLiteral
<|> fmap IntConst integer
expr2 = try $ chainl1 expr1 accessOp
<|> expr1
expr3 = try funDef
<|> try (call expr2 exprparser)
<|> expr2
term = try consExpr
<|> expr'
<|> expr3
seqStmt = sepBy1 statement semi