[project @ 1999-01-18 19:38:27 by sof]
[nofib.git] / real / symalg / Eval.hs
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])