redefintions of functions adds pattern; fix [] pattern yielding [UnitP]

ast.hs

@@ -4,6 +4,7 @@ data AST = Add AST AST
 		 | Mul AST AST
 		 | Block [AST]
 		 | FunDef String ([Pattern], AST)
+		 | Defun String AST
 		 | Def String AST
 		 | Var String
 		 | Lambda [(Pattern, [AST])]

interp.hs

@@ -82,6 +82,18 @@ eval (Var var) = get >>= \(_,env) ->
     Just v -> return v
     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
 	v <- eval v'
 	(s,env) <- get

parser.hs

@@ -71,8 +71,7 @@ consPattern = do
 	y <- pattern
 	return $ ConsP x y
 
-pattern = option UnitP $
-			try consPattern
+pattern = try consPattern
 		<|> listPattern
 	    <|> varPattern
 	    <|> intPattern
@@ -87,11 +86,11 @@ funDef = do
 	symbol ")"
 	symbol "->"
 	lst <- exprparser
-	return $ rewriteFun (FunDef name (pats, lst))
+	return $ rewriteFun (FunDef name (pats', lst))
 
 -- curry FunDef to a definition of lambdas
 rewriteFun (FunDef name (patterns, body)) =
-	Def name lam
+	Defun name lam
 	where
 		-- curry it
 		lam = foldr (\pat lam -> Lambda [(pat, [lam])]) body patterns