diff options
Diffstat (limited to 'Eval.hs')
| -rw-r--r-- | Eval.hs | 144 |
1 files changed, 144 insertions, 0 deletions
@@ -0,0 +1,144 @@ +module Eval where + +import Abs +import Prelude hiding (lookup) +import Parser.AbsSchmim +import Control.Monad.Reader +import Data.Map.Lazy +import Typecheck + +type Interpreter a = ReaderT Env (Either String) a + +eval :: Exp -> Interpreter Val +eval (EAdd e1 e2) = do + (VNum v1) <- eval e1 + (VNum v2) <- eval e2 + return (VNum $ v1 + v2) +eval (EMul e1 e2) = do + (VNum v1) <- eval e1 + (VNum v2) <- eval e2 + return (VNum $ v1 * v2) +eval (ESub e1 e2) = do + (VNum v1) <- eval e1 + (VNum v2) <- eval e2 + return (VNum $ v1 - v2) +eval (EDiv e1 e2) = do + (VNum v1) <- eval e1 + (VNum v2) <- eval e2 + if v2 == 0 + then lift $ Left "division by 0" + else return (VNum $ v1 `div` v2) +eval (EVar x) = do + (Just v) <- asks $ lookup x + return v +eval (ENum n) = return (VNum n) +eval (EAbs x t e) = do + env <- ask + return $ VAbs x t env e +eval (EApp e1 []) = do + eval e1 +eval (EApp e1 [e2]) = do + (VAbs x t env e) <- eval e1 + v <- eval e2 + local (\_ -> insert x v env) $ eval e +eval (EApp e1 (e2:es)) = do + eval (EApp (EApp e1 [e2]) es) +eval ETr = return VTr +eval EFl = return VFl +eval (EEq e1 e2) = do + (VNum v1) <- eval e1 + (VNum v2) <- eval e2 + return $ if v1 == v2 then VTr else VFl +eval (ELeq e1 e2) = do + (VNum v1) <- eval e1 + (VNum v2) <- eval e2 + return $ if v1 <= v2 then VTr else VFl +eval (EGeq e1 e2) = do + (VNum v1) <- eval e1 + (VNum v2) <- eval e2 + return $ if v1 >= v2 then VTr else VFl +eval (ELess e1 e2) = do + (VNum v1) <- eval e1 + (VNum v2) <- eval e2 + return $ if v1 < v2 then VTr else VFl +eval (EGrt e1 e2) = do + (VNum v1) <- eval e1 + (VNum v2) <- eval e2 + return $ if v1 > v2 then VTr else VFl +eval (EAnd e1 e2) = do + v1 <- eval e1 + v2 <- eval e2 + return $ case (v1, v2) of + (VTr, VTr) -> VTr + _ -> VFl +eval (EOr e1 e2) = do + v1 <- eval e1 + v2 <- eval e2 + return $ case (v1, v2) of + (VFl, VFl) -> VFl + _ -> VTr +eval (EIfte e1 e2 e3) = do + v1 <- eval e1 + let e = case v1 of + VTr -> e2 + VFl -> e3 + eval e +eval (EVrnt l e t) = do + v <- eval e + return $ VVrnt l v t +eval (ETpl es) = do + vs <- forM es eval + return $ VTpl vs +eval (EProj e i) = do + (VTpl vs) <- eval e + return $ vs !! (fromIntegral (i - 1)) +eval (EMtch e ms) = do + (VVrnt l v t) <- eval e + let (Matching _ x e') = lookupLabel l ms + local (insert x v) $ eval e' + where + lookupLabel l (m@(Matching l' x e):ms) + | l == l' = m + | otherwise = lookupLabel l ms +eval (ENil t) = return $ VNil t +eval (ECons e1 e2) = do + v1 <- eval e1 + v2 <- eval e2 + return (VCons v1 v2) +eval (EHead e) = do + v <- eval e + case v of + (VNil _) -> lift $ Left "head of empty list" + (VCons v _) -> return v +eval (ETail e) = do + v <- eval e + case v of + (VNil _) -> lift $ Left "tail of empty list" + (VCons _ v) -> return v +eval (EIsnil e) = do + v <- eval e + return $ case v of + (VNil _) -> VTr + _ -> VFl +eval (EFix (EAbs x t e)) = do + env <- ask + let env' = insert x (forcedEval (EFix (EAbs x t e)) env') env + local (\_ -> env') $ eval e + where + forcedEval e env = case runReaderT (eval e) env of + Right v -> v +eval (ELet x ps e1 e2) = do + eval (EApp (EAbs x t e2) [e1']) + where + (e1', t) = Prelude.foldr (\(Param x t') (e, t) -> ((EAbs x t' e), TFun t' t)) (e1, placeholderType) ps +eval (ELetrec x _ ps e1 e2) = do + eval (EApp (EAbs x t e2) [(EFix (EAbs x t e1'))]) + where + (e1', t) = Prelude.foldr (\(Param x t') (e, t) -> ((EAbs x t' e), TFun t' t)) (e1, placeholderType) ps + +placeholderType = TInt + +interp :: Exp -> Either String Val +interp e = case runReaderT (typeof e) empty of + (Just t) -> runReaderT (eval e) empty + Nothing -> Left "badly typed expression" |