diff --git a/ast.hs b/ast.hs index 0e54b47..510785c 100644 --- a/ast.hs +++ b/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 diff --git a/interp.hs b/interp.hs index 04755e3..b528195 100644 --- a/interp.hs +++ b/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 diff --git a/parser.hs b/parser.hs index e86358e..524517e 100644 --- a/parser.hs +++ b/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