102 lines
2.8 KiB
Haskell
102 lines
2.8 KiB
Haskell
{-# Language LambdaCase, Strict #-}
|
|
|
|
module Interpreter.Self where
|
|
|
|
import Chi
|
|
import Interpreter.Haskell
|
|
|
|
-- Task 3
|
|
|
|
mapExp :: Exp
|
|
mapExp = parse
|
|
"\\f. rec map = \\xs. case xs of \
|
|
\ { Nil() -> Nil() \
|
|
\ ; Cons(x,xs) -> Cons(f x, map xs)\
|
|
\ }"
|
|
|
|
ifExp :: Exp
|
|
ifExp = parse
|
|
"\\b. \\t. \\f. case b of \
|
|
\ { True() -> t \
|
|
\ ; False() -> f \
|
|
\ }"
|
|
|
|
equalExp :: Exp
|
|
equalExp = parse
|
|
"rec equal = \\m. \\n. case m of \
|
|
\ { Zero() -> case n of { Zero() -> True(); Suc(n) -> False() } \
|
|
\ ; Suc(m) -> case n of { Zero() -> False(); Suc(n) -> equal m n }\
|
|
\ }"
|
|
|
|
elemExp :: Exp
|
|
elemExp =
|
|
subst (Variable "equal") equalExp .
|
|
subst (Variable "if") ifExp $ parse
|
|
"\\x. rec elem = \\l. case l of \
|
|
\ { Nil() -> False() \
|
|
\ ; Cons(v,vs) -> if (equal x v) True() (elem vs)\
|
|
\ }"
|
|
|
|
substBrExp :: Exp
|
|
substBrExp =
|
|
subst (Variable "if") ifExp .
|
|
subst (Variable "elem") elemExp $ parse
|
|
"\\subst. \\var. \\b. case b of \
|
|
\ { Branch(c,vs,e') -> if (elem var vs) Branch(c,vs,e') Branch(c,vs, subst e') \
|
|
\ }"
|
|
|
|
substExp :: Exp
|
|
substExp =
|
|
subst (Variable "if") ifExp .
|
|
subst (Variable "equal") equalExp .
|
|
subst (Variable "substBr") substBrExp .
|
|
subst (Variable "map") mapExp $ parse
|
|
"\\var. \\e. rec subst = \\x. case x of\
|
|
\ { Apply(e1,e2) -> Apply(subst e1, subst e2) \
|
|
\ ; Lambda(x,y) -> if (equal x var) Lambda(x,y) Lambda(x,subst y) \
|
|
\ ; Var(x) -> if (equal x var) e Var(x) \
|
|
\ ; Const(c,es) -> Const(c, map subst es) \
|
|
\ ; Rec(x, e') -> if (equal x var) Rec(x,e') Rec(x,subst e')\
|
|
\ ; Case(e',bs) -> Case(subst e', map (substBr subst var) bs) \
|
|
\ }"
|
|
|
|
-- Task 4
|
|
|
|
lookupExp :: Exp
|
|
lookupExp =
|
|
subst (Variable "if") ifExp .
|
|
subst (Variable "equal") equalExp $ parse
|
|
"\\c. rec lookup = \\xs. case xs of \
|
|
\ -- TODO: Fix for Nil() \
|
|
\ { Cons(b,bs) -> \
|
|
\ case b of \
|
|
\ { Branch(c', bs, e') -> if (equal c c') Pair(bs,e') (lookup bs) } \
|
|
\ }"
|
|
|
|
substsExp :: Exp
|
|
substsExp =
|
|
subst (Variable "subst") substExp $ parse
|
|
"rec substs = \\xs. \\vs. \\e'. case xs of \
|
|
\ { Nil() -> case vs of { Nil() -> e' } \
|
|
\ ; Cons(x,xs) -> case vs of { Cons(v,vs) -> subst x v (substs xs vs e') }\
|
|
\ }"
|
|
|
|
evalExp :: Exp
|
|
evalExp =
|
|
subst (Variable "map") mapExp .
|
|
subst (Variable "lookup") lookupExp .
|
|
subst (Variable "substs") substsExp .
|
|
subst (Variable "subst") substExp $ parse
|
|
"rec eval = \\e. case e of \
|
|
\ { Lambda(x,e) -> Lambda(x,e) \
|
|
\ ; Apply(e1,e2) -> case eval e1 of \
|
|
\ { Lambda(x,e) -> eval (subst x (eval e2) e) } \
|
|
\ ; Rec(x,e) -> eval (subst x Rec(x,e) e) \
|
|
\ ; Const(c,es) -> Const(c, map eval es) \
|
|
\ ; Case(e,bs) -> case eval e of \
|
|
\ { Const(c,vs) -> case lookup c bs of \
|
|
\ { Pair(xs,e') -> eval (substs xs vs e') } \
|
|
\ } \
|
|
\ ; Var(x) -> Var(x) \
|
|
\ }"
|