Tehee

3or4/Interpreter/Haskell.hs

@@ -0,0 +1,48 @@
+{-# Language LambdaCase, Strict #-}
+
+module Interpreter.Haskell where
+
+import Chi
+import Data.Functor           ( (<&>) )
+import Control.Monad.Identity ( Identity( runIdentity ) )
+
+-- Task 3
+subst :: Variable -> Exp -> Exp -> Exp
+subst var e = \case
+  Apply e1 e2 -> Apply (subst var e e1) (subst var e e2)
+  Lambda x e' -> Lambda x $ if var /= x then subst var e e' else e'
+  Var x -> if var == x then e else Var x
+  Const c es -> Const c $ map (subst var e) es
+  Rec x e' -> Rec x $ if var /= x then subst var e e' else e'
+  Case e' bs -> Case (subst var e e') $ map substBr bs
+    where
+      substBr :: Br -> Br
+      substBr (Branch c vs e') = Branch c vs $ if var `notElem` vs then subst var e e' else e'
+
+-- Task 5
+eval :: Exp -> Exp
+eval = runIdentity . eval'
+  where
+    eval' :: Exp -> Identity Exp
+    eval' = \case
+      e@(Apply e1 e2) -> eval' e1 >>= \case
+        Lambda x e' -> eval' e2 >>= eval' . flip (subst x) e'
+        _ -> error $ "Function was not function in evaluation: " <> show e
+      Const c es -> mapM eval' es <&> Const c
+      Rec x e -> eval' $ subst x (Rec x e) e
+      Case e bs -> eval' e >>= \case
+        Const c vs -> lookupBranch c bs >>= \case
+          (xs,e') ->
+            if length vs /= length xs then error "Not the same amount of arguments in case" else
+            eval' $ foldr (uncurry subst) e' (zip xs vs)
+        e -> error $ "Non const in case: " <> show e
+      x -> pure x
+    
+    lookupBranch :: Constructor -> [Br] -> Identity ([Variable], Exp)
+    lookupBranch c [] = error "No matching branch"
+    lookupBranch c ((Branch c' bs e):brs) =
+      if c == c'
+      then pure (bs,e)
+      else lookupBranch c brs
+
+

3or4/Interpreter/Self.hs

@@ -0,0 +1,42 @@
+{-# Language LambdaCase, Strict #-}
+
+module Interpreter.Self where
+
+import Chi
+import Interpreter.Haskell
+
+mapExp :: Exp
+mapExp = parse
+  "\\f. rec map = \\xs. case xs of \
+  \ { Nil() -> Nil() \
+  \ ; Cons(x,xs) -> Cons(f x, map xs)\
+  \ }"
+
+substBrExp :: Exp
+substBrExp = parse
+  "rec substBr = \\x. "
+
+ifExp :: Exp
+ifExp = parse
+  "\\b. \\t. \\f. case b of \
+  \ { True() -> t \
+  \ ; False() -> f \
+  \ }"
+
+equalExp :: Exp
+equalExp = parse ""
+
+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) -> _ \
+        \ }"