int.icl

   1 implementation module int
   2
   3 import StdEnv
   4
   5 import Data.Either
   6 import Data.Functor
   7 import Data.Maybe
   8 import Data.List
   9 import Control.Applicative
  10 import Control.Monad
  11 import Control.Monad.State
  12 import Control.Monad.Trans
  13
  14 import ast
  15
  16 int :: Expression -> Either [String] Value
  17 int e = evalStateT (eval e >>= printer) preamble
  18
  19 err :: String -> Eval a
  20 err e = liftT (Left [e])
  21
  22 :: Eval a :== StateT EvalState (Either [String]) a
  23 :: EvalState :== [([Char], Value)]
  24 preamble =
  25         [(['if'], Func 3 [] (Builtin ['if']))
  26         ,(['eq'], Func 2 [] (Builtin ['eq']))
  27         ,(['mul'], Func 2 [] (Builtin ['mul']))
  28         ,(['div'], Func 2 [] (Builtin ['div']))
  29         ,(['add'], Func 2 [] (Builtin ['add']))
  30         ,(['sub'], Func 2 [] (Builtin ['sub']))
  31         ]
  32
  33 sub :: [Char] Expression Expression -> Expression
  34 sub ident subst (Let v b rest)
  35         = Let v (sub ident subst b)
  36                 (if (v == ident) rest (sub ident subst rest))
  37 sub ident subst (Var v)
  38         | ident == v = subst
  39 sub ident subst (App e1 e2) = App (sub ident subst e1) (sub ident subst e2)
  40 sub ident subst (Lambda v b)
  41         | ident <> v = Lambda v (sub ident b subst)
  42 sub _ _ x = x
  43
  44 printer :: Value -> Eval Value
  45 printer (Func 0 args body) = eval (body args) >>= printer
  46 printer a = pure a
  47
  48 eval :: Expression -> Eval Value
  49 eval (Let ident body rest)
  50         =   modify (\vs->[(ident, Func 0 [] \_->body):vs])
  51         >>| eval rest
  52 eval (Lit v) = pure v
  53 eval (Var v) = gets (lookup v) >>= maybe (err (toString v +++ " not found")) pure
  54 eval (App e1 e2) = eval e1 >>= \v->case v of
  55 //      (Func 0 a b) = err ("Saturated function: : " +++ toString e1)
  56         (Func n as b) = pure (Func (n-1) (as ++ [e2]) b)
  57 //      _ = err ("Cannot apply " +++ toString e2 +++ " to " +++ toString e1)
  58 eval (Lambda a b) = pure (Func 1 [] (\[arg]->sub a arg b))
  59 eval (Builtin i as) = case (i, as) of
  60         (['if'], [p,t,e]) = eval p >>= printer >>= \v->case v of
  61                 Bool v = eval (if v t e)
  62 //              _ = err ("first argument of if must be a bool but is " +++ toString v)
  63         (['add'], [l,r]) = eval l >>= printer >>= \l->eval r >>= printer >>= \r->case (l,r) of
  64                 (Int a, Int b) = pure (Int (a + b))
  65 //              _ = err "add only defined for integers"
  66         (['sub'], [l,r]) = eval l >>= printer >>= \l->eval r >>= printer >>= \r->case (l,r) of
  67                 (Int a, Int b) = pure (Int (a - b))
  68 //              _ = err "sub only defined for integers"
  69         (['mul'], [l,r]) = eval l >>= printer >>= \l->eval r >>= printer >>= \r->case (l,r) of
  70                 (Int a, Int b) = pure (Int (a * b))
  71 //              _ = err "mul only defined for integers"
  72         (['div'], [l,r]) = eval l >>= \l->eval r >>= \r->case (l,r) of
  73                 (Int a, Int b) = pure (Int (a / b))
  74 //              _ = err "div only defined for integers"
  75         (['eq'], [l,r]) = eval l >>= printer >>= \l->eval r >>= printer >>= \r->case (l,r) of
  76                 (Int a, Int b) = pure (Bool (a == b))
  77 //              _ = err "eq only defined for integers"