From 8043186001061b33a49a0270a076b588e7921453 Mon Sep 17 00:00:00 2001
From: Ivy <adrisolgo7373@gmail.com>
Date: Sat, 30 Jan 2021 20:21:25 +0100
Subject: [PATCH] Added some testing functions, apply and currification

---
 src/Enviroment.hs | 11 ++++++++++-
 src/Evaluator.hs  | 18 ++++++++++++------
 src/ExprType.hs   |  1 +
 3 files changed, 23 insertions(+), 7 deletions(-)

diff --git a/src/Enviroment.hs b/src/Enviroment.hs
index 113b106..8569f9b 100644
--- a/src/Enviroment.hs
+++ b/src/Enviroment.hs
@@ -8,7 +8,9 @@ data Enviroment = Enviroment (M.Map String Expr) (Maybe Enviroment)
 
 base :: Enviroment
 base = Enviroment (M.fromList [
-  ("test-var", IntE 10)
+  ("test-var", IntE 10),
+  ("id", LambdaE "x" $ VarE "x"),
+  ("first", LambdaE "x" $ LambdaE "y" $ VarE "x")
   ]) Nothing
 
 lookupVar :: Enviroment -> String -> Maybe Expr
@@ -17,3 +19,10 @@ lookupVar (Enviroment menv upperEnv) var = let mExpr = M.lookup var menv in
 
 insertVar :: Enviroment -> String -> Expr -> Enviroment
 insertVar (Enviroment menv u) var expr = Enviroment (M.insert var expr menv) u
+
+emptyEnv :: Enviroment
+emptyEnv = Enviroment M.empty Nothing
+
+extendEnv :: Enviroment -> Enviroment -> Enviroment
+extendEnv (Enviroment menv Nothing) upper = Enviroment menv (Just upper)
+extendEnv (Enviroment menv (Just upperMenv)) upper = Enviroment menv (Just $ extendEnv upperMenv upper)
diff --git a/src/Evaluator.hs b/src/Evaluator.hs
index 007c3da..e717ee3 100644
--- a/src/Evaluator.hs
+++ b/src/Evaluator.hs
@@ -8,12 +8,18 @@ import Data.Maybe
 -- TODO: create a BuiltinProc or something like that in data Expr, and make + a builtin proc
 
 eval :: Enviroment -> Expr -> (Enviroment, Expr)
-eval env i@(IntE _)    = (env, i)
-eval env (VarE v)      = eval env $ fromJust $ lookupVar env v
-eval env (SetE v expr) = (insertVar env v expr, NilE)
+eval env i@(IntE _)     = (env, i)
+eval env (VarE v)       = eval env $ fromJust $ lookupVar env v
+eval env (SetE v expr)  = (insertVar env v expr, NilE)
 eval env (QuotedE e)    = (env, e)
-eval env (ConsE car cdr) = (env, apply car cdr)
+eval env (ConsE p args) = (fEnv, fExpr)
+  where (uEnv, ap)    = eval env p
+        (aEnv, aExpr) = apply ap args
+        (fEnv, fExpr) = eval (extendEnv aEnv uEnv) aExpr
+eval env (LambdaE arg expr) = (env, LambdaE arg expr)
 eval env NilE          = (env, NilE)
 
-apply :: Expr -> Expr -> Expr
-apply car cdr = undefined
+apply :: Expr -> Expr -> (Enviroment, Expr)
+apply (LambdaE p expr) (ConsE x xs) = (extendEnv (insertVar emptyEnv p x) nEnv, nExp)
+  where (nEnv, nExp) = apply expr xs
+apply e NilE = (emptyEnv, e)
diff --git a/src/ExprType.hs b/src/ExprType.hs
index 73a4fde..458f202 100644
--- a/src/ExprType.hs
+++ b/src/ExprType.hs
@@ -4,6 +4,7 @@ data Expr = IntE Integer
           | VarE String
           | SetE String Expr
           | ConsE Expr Expr
+          | LambdaE String Expr
           | QuotedE Expr
           | NilE
           deriving (Show)