redefintions of functions adds pattern; fix [] pattern yielding [UnitP]
This commit is contained in:
parent
f138c7475b
commit
7bebcdd1dc
1
ast.hs
1
ast.hs
|
@ -4,6 +4,7 @@ data AST = Add AST AST
|
||||||
| Mul AST AST
|
| Mul AST AST
|
||||||
| Block [AST]
|
| Block [AST]
|
||||||
| FunDef String ([Pattern], AST)
|
| FunDef String ([Pattern], AST)
|
||||||
|
| Defun String AST
|
||||||
| Def String AST
|
| Def String AST
|
||||||
| Var String
|
| Var String
|
||||||
| Lambda [(Pattern, [AST])]
|
| Lambda [(Pattern, [AST])]
|
||||||
|
|
12
interp.hs
12
interp.hs
|
@ -82,6 +82,18 @@ eval (Var var) = get >>= \(_,env) ->
|
||||||
Just v -> return v
|
Just v -> return v
|
||||||
Nothing -> error $ "unbound variable " ++ var
|
Nothing -> error $ "unbound variable " ++ var
|
||||||
|
|
||||||
|
eval (Defun name fn) = do
|
||||||
|
(s,env) <- get
|
||||||
|
case lookup env name of
|
||||||
|
Nothing -> -- bind new fn
|
||||||
|
eval fn >>= \fn' ->
|
||||||
|
put (s, bind env name fn') >> return fn'
|
||||||
|
Just oldfn -> -- add pattern to old fn
|
||||||
|
let FnV oldpats = oldfn
|
||||||
|
Lambda [(pat, body)] = fn
|
||||||
|
newfn = FnV ((pat, body):oldpats) in
|
||||||
|
put (s, bind env name newfn) >> return newfn
|
||||||
|
|
||||||
eval (Def name v') = do
|
eval (Def name v') = do
|
||||||
v <- eval v'
|
v <- eval v'
|
||||||
(s,env) <- get
|
(s,env) <- get
|
||||||
|
|
|
@ -71,8 +71,7 @@ consPattern = do
|
||||||
y <- pattern
|
y <- pattern
|
||||||
return $ ConsP x y
|
return $ ConsP x y
|
||||||
|
|
||||||
pattern = option UnitP $
|
pattern = try consPattern
|
||||||
try consPattern
|
|
||||||
<|> listPattern
|
<|> listPattern
|
||||||
<|> varPattern
|
<|> varPattern
|
||||||
<|> intPattern
|
<|> intPattern
|
||||||
|
@ -87,11 +86,11 @@ funDef = do
|
||||||
symbol ")"
|
symbol ")"
|
||||||
symbol "->"
|
symbol "->"
|
||||||
lst <- exprparser
|
lst <- exprparser
|
||||||
return $ rewriteFun (FunDef name (pats, lst))
|
return $ rewriteFun (FunDef name (pats', lst))
|
||||||
|
|
||||||
-- curry FunDef to a definition of lambdas
|
-- curry FunDef to a definition of lambdas
|
||||||
rewriteFun (FunDef name (patterns, body)) =
|
rewriteFun (FunDef name (patterns, body)) =
|
||||||
Def name lam
|
Defun name lam
|
||||||
where
|
where
|
||||||
-- curry it
|
-- curry it
|
||||||
lam = foldr (\pat lam -> Lambda [(pat, [lam])]) body patterns
|
lam = foldr (\pat lam -> Lambda [(pat, [lam])]) body patterns
|
||||||
|
|
Loading…
Reference in New Issue