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])