use patterns for definitions instead of identifiers
This commit is contained in:
parent
19aa9410fb
commit
ef80d723ca
3 changed files with 11 additions and 8 deletions
2
ast.hs
2
ast.hs
|
@ -15,7 +15,7 @@ data AST = Add AST AST
|
||||||
| Block [AST]
|
| Block [AST]
|
||||||
| FunDef String (Pattern, AST)
|
| FunDef String (Pattern, AST)
|
||||||
| Defun String AST
|
| Defun String AST
|
||||||
| Def String AST
|
| Def Pattern AST
|
||||||
| Var String
|
| Var String
|
||||||
| Lambda [(Pattern, AST)]
|
| Lambda [(Pattern, AST)]
|
||||||
| Call String AST
|
| Call String AST
|
||||||
|
|
11
interp.hs
11
interp.hs
|
@ -219,11 +219,14 @@ eval (Defun name fn) = do
|
||||||
newfn = FnV cls (oldpats ++ [(pat, body)]) in
|
newfn = FnV cls (oldpats ++ [(pat, body)]) in
|
||||||
put (s, bind env name newfn) >> return newfn
|
put (s, bind env name newfn) >> return newfn
|
||||||
|
|
||||||
eval (Def name v') = do
|
eval (Def pat v') = do
|
||||||
v <- eval v'
|
v <- eval v'
|
||||||
(s,env) <- get
|
(s,locals:xs) <- get
|
||||||
put (s, bind env name v)
|
case patternBindings pat v of
|
||||||
return v
|
Nothing -> error $ "pattern binding doesn't satisfy: " ++ show v ++ " with " ++ show pat
|
||||||
|
Just bindings ->
|
||||||
|
put (s, (M.union bindings locals):xs) >> -- update our local bindings
|
||||||
|
return v
|
||||||
|
|
||||||
eval (Lambda pats) =
|
eval (Lambda pats) =
|
||||||
get >>= \(_,env) ->
|
get >>= \(_,env) ->
|
||||||
|
|
|
@ -158,23 +158,23 @@ ifExpr = do
|
||||||
bool = fmap BoolConst $ (symbol "true" >> return True) <|> (symbol "false" >> return False)
|
bool = fmap BoolConst $ (symbol "true" >> return True) <|> (symbol "false" >> return False)
|
||||||
|
|
||||||
def = do
|
def = do
|
||||||
name <- identifier
|
pat <- pattern
|
||||||
whiteSpace
|
whiteSpace
|
||||||
symbol "="
|
symbol "="
|
||||||
value <- exprparser
|
value <- exprparser
|
||||||
return $ Def name value
|
return $ Def pat value
|
||||||
|
|
||||||
expr' = try block
|
expr' = try block
|
||||||
<|> try funDef
|
<|> try funDef
|
||||||
<|> try call
|
<|> try call
|
||||||
<|> try lambda
|
<|> try lambda
|
||||||
|
<|> try def
|
||||||
<|> try (emptyTuple TupleConst)
|
<|> try (emptyTuple TupleConst)
|
||||||
<|> try (tupleSeq exprparser TupleConst)
|
<|> try (tupleSeq exprparser TupleConst)
|
||||||
<|> parens exprparser
|
<|> parens exprparser
|
||||||
<|> listSeq exprparser ListConst
|
<|> listSeq exprparser ListConst
|
||||||
<|> try ifExpr
|
<|> try ifExpr
|
||||||
<|> try bool
|
<|> try bool
|
||||||
<|> try def
|
|
||||||
<|> fmap Var identifier
|
<|> fmap Var identifier
|
||||||
<|> fmap StrConst stringLiteral
|
<|> fmap StrConst stringLiteral
|
||||||
<|> fmap IntConst integer
|
<|> fmap IntConst integer
|
||||||
|
|
Loading…
Reference in a new issue