1 module Eval (eval,getPrec) where 2 3 import BasicNumber 4 import BasicNumberApprox 5 import Ast 6 import Env 7 8 -- eval takes an expression and environment, tries to reduce the expression, 9 -- and returns the reduced expression. 10 eval :: BasicExp -> Env -> BasicExp 11 eval (EVar evar) env = eval (lookupEnv evar env) env 12 eval (Func name args) env = case args of 13 [] -> Func name [] 14 [arg] -> eval_func_1 name arg env 15 [arg1,arg2] -> eval_func_2 name arg1 arg2 env 16 args -> eval_func_n name args env 17 eval bexp env = bexp 18 19 -- get precision from the environment 20 getPrec :: Env -> Integer 21 getPrec env = prec 22 where 23 prec = read (show bprec) 24 bprec = case pexpr of 25 (Numb n) -> -n 26 _ -> -10 27 pexpr1 = lookupEnv "$prec" env 28 pexpr = eval pexpr1 env 29 30 -- evaluate functions with 1 argument. 31 eval_func_1 :: String -> BasicExp -> Env -> BasicExp 32 eval_func_1 name arg env = 33 if isBuiltin1 name then 34 (getBuiltin1 name) narg (getPrec env) 35 else Func name [narg] 36 where 37 narg = eval arg env 38 39 -- evaluate functions with 2 arguments. 40 eval_func_2 :: String -> BasicExp -> BasicExp -> Env -> BasicExp 41 eval_func_2 name arg1 arg2 env = 42 if isBuiltin2 name then 43 (getBuiltin2 name narg1 narg2) narg1 narg2 (getPrec env) 44 else Func name [narg1,narg2] 45 where 46 narg1 = eval arg1 env 47 narg2 = eval arg2 env 48 49 -- evaluate functions with n(n>2) arguments. 50 eval_func_n :: String -> [BasicExp] -> Env -> BasicExp 51 eval_func_n name args env = Func name nargs 52 where 53 nargs = map eval_element args 54 eval_element elem = eval elem env 55 56 -- test if a function is builtin of arity 1 57 isBuiltin1 :: String -> Bool 58 isBuiltin1 "sqrt" = True 59 isBuiltin1 "real" = True 60 isBuiltin1 "rat" = True 61 isBuiltin1 "neg" = True 62 isBuiltin1 _ = False 63 64 -- get a builtin function with 1 argument 65 66 getBuiltin1 :: String -> (BasicExp -> Integer -> BasicExp) 67 getBuiltin1 "sqrt" = aBnf2Bef1 "sqrt" sqrt1 where 68 sqrt1 :: BasicNumber -> Integer -> BasicNumber 69 sqrt1 n _ = sqrt n 70 getBuiltin1 "real" = aBnf2Bef1 "real" makeReal1 where 71 makeReal1 :: BasicNumber -> Integer -> BasicNumber 72 makeReal1 n _ = makeReal n 73 getBuiltin1 "rat" = aBnf2Bef1 "rat" rtoRational 74 getBuiltin1 "neg" = aBnf2Bef1 "neg" negation where 75 negation :: BasicNumber -> Integer -> BasicNumber 76 negation x _ = 0-x 77 78 -- convert arithmetic functions on numbers to those on expressions 79 80 aBnf2Bef1 :: String -> (BasicNumber -> Integer -> BasicNumber) -> 81 (BasicExp -> Integer -> BasicExp) 82 83 aBnf2Bef1 name fun arg prec = 84 case arg of 85 (Numb n) -> Numb (fun n prec) 86 _ -> (Func name [arg]) 87 88 -- test if a function is builtin of arity 2 89 isBuiltin2 :: String -> Bool 90 isBuiltin2 "add" = True 91 isBuiltin2 "sub" = True 92 isBuiltin2 "mul" = True 93 isBuiltin2 "div" = True 94 isBuiltin2 "equ" = True 95 isBuiltin2 "ne" = True 96 isBuiltin2 "gte" = True 97 isBuiltin2 "lte" = True 98 isBuiltin2 "lt" = True 99 isBuiltin2 "gt" = True 100 isBuiltin2 _ = False 101 102 -- get a builtin function with 2 arguments 103 getBuiltin2 :: String -> BasicExp -> BasicExp -> 104 (BasicExp -> BasicExp -> Integer -> BasicExp) 105 getBuiltin2 "add" _ _ = aBnf2Bef "add" (+) 106 getBuiltin2 "sub" _ _ = aBnf2Bef "sub" (-) 107 getBuiltin2 "mul" _ _ = aBnf2Bef "mul" (*) 108 getBuiltin2 "div" _ _ = aBnf2Bef "div" (/) 109 getBuiltin2 "equ" _ _ = bBnf2Bef "equ" equ 110 getBuiltin2 "ne" _ _ = bBnf2Bef "ne" ne 111 getBuiltin2 "lt" _ _ = bBnf2Bef "lt" lt 112 getBuiltin2 "gt" _ _ = bBnf2Bef "gt" gt 113 getBuiltin2 "gte" _ _ = bBnf2Bef "gte" gte 114 getBuiltin2 "lte" _ _ = bBnf2Bef "lte" lte 115 116 -- convert Haskell boolean to basic expression 117 bool2bexp :: Bool -> BasicExp 118 bool2bexp True = Numb 1 119 bool2bexp False = Numb 0 120 121 -- convert boolean functions on numbers to those on expressions 122 123 bBnf2Bef :: String -> (BasicNumber -> BasicNumber -> Integer -> Bool) 124 -> BasicExp -> BasicExp -> Integer -> BasicExp 125 bBnf2Bef name fun e1 e2 prec = 126 case (e1,e2) of 127 ((Numb n1),(Numb n2)) -> bool2bexp (fun n1 n2 prec) 128 _ -> (Func name [e1,e2]) 129 130 -- convert arithmetic functions on numbers to those on expressions 131 132 aBnf2Bef :: String -> (BasicNumber -> BasicNumber -> BasicNumber) -> 133 (BasicExp -> BasicExp -> Integer -> BasicExp) 134 aBnf2Bef name fun arg1 arg2 _ = 135 case (arg1,arg2) of 136 ((Numb n1),(Numb n2)) -> Numb (fun n1 n2) 137 _ -> (Func name [arg1, arg2])