add other arithmetic operators

ast.hs

@@ -1,7 +1,9 @@
 module AST where
 
 data AST = Add AST AST
+		 | Sub AST AST
 		 | Mul AST AST
+		 | Div AST AST
 		 | Block [AST]
 		 | FunDef String ([Pattern], AST)
 		 | Defun String AST

interp.hs

@@ -30,10 +30,20 @@ lookup env name = M.lookup name env
 bind :: Env -> String -> Value -> Env
 bind env name value = M.insert name value env
 
+-- value operators
 (IntV l) +$ (IntV r) = IntV (l + r)
 (StrV l) +$ (StrV r) = StrV (l ++ r)
 l +$ r = error $ "cannot + " ++ show l ++ " and " ++ show r
 
+(IntV l) -$ (IntV r) = IntV (l - r)
+l -$ r = error $ "cannot - " ++ show l ++ " and " ++ show r
+
+(IntV l) *$ (IntV r) = IntV (l * r)
+l *$ r = error $ "cannot * " ++ show l ++ " and " ++ show r
+
+(IntV l) /$ (IntV r) = IntV (l `div` r)
+l /$ r = error $ "cannot / " ++ show l ++ " and " ++ show r
+
 -- these are pretty nasty and instead of using unsafePerformIO
 -- we could throw eval, etc. into StateT with IO instead, but then
 -- everything would be in IO.
@@ -103,10 +113,10 @@ eval (Def name v') = do
 eval (Lambda pats) =
 	return $ FnV pats
 
-eval (Add l r) = do
-	l <- eval l
-	r <- eval r
-	return $ l +$ r
+eval (Add l r) = do { l <- eval l; r <- eval r; return $ l +$ r }
+eval (Sub l r) = do { l <- eval l; r <- eval r; return $ l -$ r }
+eval (Mul l r) = do { l <- eval l; r <- eval r; return $ l *$ r }
+eval (Div l r) = do { l <- eval l; r <- eval r; return $ l /$ r }
 
 eval (Call name args) = get >>= \(_,env) ->
 	case lookup env name of

parser.hs

@@ -14,12 +14,14 @@ languageDef = emptyDef {T.commentStart="{-",
 						  T.identStart = letter <|> char '_',
 						  T.identLetter = alphaNum <|> char '_',
 						  T.reservedNames = ["do", "end"],
-						  T.reservedOpNames = ["+", "*"]}
+						  T.reservedOpNames = ["+", "-", "*", "/"]}
 
 lexer = T.makeTokenParser languageDef
 exprparser = buildExpressionParser ops term <?> "expression"
-ops = [ [Infix (reservedOp "*" >> return Mul) AssocLeft ]
+ops = [ [Infix (reservedOp "*" >> return Mul) AssocLeft]
+	  , [Infix (reservedOp "/" >> return Div) AssocLeft]
 	  , [Infix (reservedOp "+" >> return Add) AssocLeft]
+	  , [Infix (reservedOp "-" >> return Sub) AssocLeft]
 	  ]
 
 identifier = T.identifier lexer