/exercise3/NSWCAD.lhs
Haskell | 94 lines | 72 code | 12 blank | 10 comment | 0 complexity | d2b9d3ea3284ab2d8a487cbb9df64378 MD5 | raw file
1\begin{code} 2 3module NSWCAD where 4 5import Data.Maybe 6import qualified DeBruijn as S 7import qualified IntegerArithmetic as I 8import Debug.Trace 9 10data Value = BoolVal Bool | IntVal Integer | Clo S.Term Env 11 deriving Show 12 13type Env = [Value] 14 15evalInEnv :: Env -> S.Term -> Maybe Value 16evalInEnv e t = case t of 17 -- true,false 18 S.Tru -> Just (BoolVal True) 19 S.Fls -> Just (BoolVal False) 20 -- integer 21 S.IntConst n -> Just (IntVal n) 22 -- if 23 S.If t1 t2 t3 -> case evalInEnv e t1 of 24 Just (BoolVal True) -> case evalInEnv e t2 of 25 Just a -> Just a 26 _ -> error "if-t2" 27 Just (BoolVal False) -> case evalInEnv e t3 of 28 Just b -> Just b 29 _ -> error "if-t3" 30 _ -> error "if-t1" 31 -- var 32 S.Var i -> Just (e !! i) 33 -- app 34 S.App t1 t2 -> case evalInEnv e t1 of 35 Just (Clo (S.Abs tau t') e') -> case evalInEnv e t2 of 36 Just v' -> case evalInEnv ([v'] ++ e') t' of 37 Just vv -> Just vv 38 _ -> error "app-replacement" 39 _ -> error "app-t2 is not a value" 40 Just (Clo (S.Fix t') e') -> case evalInEnv e' (S.Fix t') of 41 Just (Clo (S.Abs tau' tt) ee) -> case evalInEnv e t2 of 42 Just v'-> case evalInEnv ([v']++ee) tt of 43 Just vv -> Just vv 44 _ -> Nothing 45 _ -> Nothing 46 _ -> Nothing 47 _ -> error "app-t1 is not an abstraction" 48 -- abs 49 S.Abs tau t1 -> Just (Clo (S.Abs tau t1) e) 50 -- add, sub,mul,div,nand 51 S.Bop op t1 t2 -> case evalInEnv e t1 of 52 Just (IntVal v1) -> case evalInEnv e t2 of 53 Just (IntVal v2) -> case op of 54 S.Add -> Just (IntVal (I.intAdd v1 v2)) 55 S.Sub -> Just (IntVal (I.intSub v1 v2)) 56 S.Mul -> Just (IntVal (I.intMul v1 v2)) 57 S.Div -> Just (IntVal (I.intDiv v1 v2)) 58 S.Nand -> Just (IntVal (I.intNand v1 v2)) 59 60 _ -> error "BOP t2 is not a value" 61 _ -> error "BOP t1 is not a value" 62 -- eq,lt 63 S.Bpr pr t1 t2 -> case evalInEnv e t1 of 64 Just (IntVal v1) -> case evalInEnv e t2 of 65 Just (IntVal v2) -> case pr of 66 S.Eq -> case I.intEq v1 v2 of 67 True -> Just (BoolVal True) 68 False -> Just (BoolVal False) 69 70 S.Lt -> case I.intLt v1 v2 of 71 True -> Just (BoolVal True) 72 False -> Just (BoolVal False) 73 74 _ -> error "BRP t2 is not a value" 75 _ -> error "BRP t1 is not a value" 76 -- let 77 S.Let t1 t2 -> case evalInEnv e t1 of 78 Just a -> case evalInEnv ([a] ++ e) t2 of 79 Just b -> Just b 80 _ -> error "let-t2 is not a value" 81 _ -> error "let t1 is not a value" 82 -- fix 83 S.Fix t1 -> case evalInEnv e t1 of 84 Just (Clo (S.Abs tau t') e') -> case evalInEnv ([Clo (S.Fix (S.Abs tau t')) e'] ++ e') t' of 85 Just b -> Just b 86 _ -> error "fix-point error" 87 _ -> error "fix-t1 is not an abstraction" 88 89 90eval :: S.Term -> Value 91eval t = fromJust (evalInEnv [] t) 92 93 94\end{code}