Call's LHS takes an AST; parse record access with op/
This commit is contained in:
parent
07a89daec1
commit
203c908f7f
3
ast.hs
3
ast.hs
|
@ -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
|
||||
|
|
12
interp.hs
12
interp.hs
|
@ -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
|
||||
|
||||
|
|
35
parser.hs
35
parser.hs
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in New Issue