int.icl

   1 implementation module int
   2
   3 import StdEnv
   4 import Data.Either
   5 import Data.Functor
   6 import Data.Maybe
   7 import Data.List
   8 import Data.Tuple
   9 import Control.Applicative
  10 import Control.Monad
  11 import Control.Monad.State
  12 import Control.Monad.Trans
  13
  14 import ast
  15
  16 :: Eval a :== StateT EvalState (Either [String]) a
  17 :: EvalState :== [([Char], Value)]
  18
  19 int :: Expression -> Either [String] Value
  20 int e = evalStateT (eval e)
  21         [(['_if'], Func \i->pure (Func \t->pure (Func \e->eval i >>= \(Bool b)->if b (eval t) (eval e))))
  22         ,(['_eq'],  binop \(Int i) (Int j)->Bool (i==j))
  23         ,(['_sub'], binop \(Int i) (Int j)->Int  (i-j))
  24         ,(['_add'], binop \(Int i) (Int j)->Int  (i+j))
  25         ,(['_mul'], binop \(Int i) (Int j)->Int  (i*j))
  26         ,(['_div'], binop \(Int i) (Int j)->Int  (i/j))
  27         ]
  28 where
  29         binop op = Func \l->pure (Func \r->op <$> eval l <*> eval r)
  30
  31 sub :: [Char] Expression Expression -> Expression
  32 sub ident subst (Let ns rest)
  33         | not (isMember ident (map fst ns))
  34                 = Let (fmap (sub ident subst) <$> ns) (sub ident subst rest)
  35 sub ident subst (Var v)
  36         | ident == v = subst
  37 sub ident subst (App e1 e2) = App (sub ident subst e1) (sub ident subst e2)
  38 sub ident subst (Lambda v b)
  39         | ident <> v = Lambda v (sub ident b subst)
  40 sub _ _ x = x
  41
  42 eval :: Expression -> Eval Value
  43 eval (Let ns rest) = sequence [eval v >>= \v->modify (\vs->[(n, v):vs])\\(n, v)<-ns] >>| eval rest
  44 eval (Lit v) = pure v
  45 eval (Var v) = gets (lookup v) >>= maybe (liftT (Left [toString v +++ " not found"])) pure
  46 eval (App e1 e2) = eval e1 >>= \(Func v)->v e2
  47 eval (Lambda a b) = pure (Func \arg->eval (sub a arg b))