Added lambda syntax on the language

cherry-lisp.cabal

@@ -22,7 +22,8 @@ executable cherry
                        Parser,
                        TokenType,
                        Lexer,
-                       Evaluator
+                       Evaluator,
+                       Enviroment
 
   build-depends:       base >= 4.7 && < 5,
                        containers,

src/Enviroment.hs

@@ -0,0 +1,28 @@
+module Enviroment where
+
+import qualified Data.Map as M
+import ExprType
+import Data.Maybe
+
+data Enviroment = Enviroment (M.Map String Expr) (Maybe Enviroment)
+
+base :: Enviroment
+base = Enviroment (M.fromList [
+  ("test-var", IntE 10),
+  ("id", LambdaE "x" $ VarE "x"),
+  ("first", LambdaE "x" $ LambdaE "y" $ VarE "x")
+  ]) Nothing
+
+lookupVar :: Enviroment -> String -> Maybe Expr
+lookupVar (Enviroment menv upperEnv) var = let mExpr = M.lookup var menv in
+  if isNothing mExpr then upperEnv >>= (`lookupVar` var) else mExpr
+
+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)

src/Evaluator.hs

@@ -1,26 +1,25 @@
 module Evaluator where
 
-import qualified Data.Map as M
 import ExprType
-
-type Env = M.Map String Expr
+import Enviroment
+import Data.Maybe
 
 -- TODO: create a separated file for builtinProcs
 -- TODO: create a BuiltinProc or something like that in data Expr, and make + a builtin proc
 
-base :: Env
-base = M.fromList [
-  ("test-var", IntE 10)
-  ]
-
-eval :: Env -> Expr -> (Env, Expr)
-eval env i@(IntE x)    = (env, i)
-eval env (VarE v)      = (M.insert v nExpr nEnv, nExpr)
-  where (nEnv, nExpr)  = eval env $ env M.! v
-eval env (SetE v expr) = (M.insert v expr env, NilE)
+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 (QuotedE e)    = (env, e)
-eval env c@(ConsE _ _) = (env, c)
+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 :: Proc -> Args -> Expr
---apply p args
+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)

src/ExprType.hs

@@ -2,11 +2,12 @@ module ExprType where
 
 data Expr = IntE Integer
           | VarE String
-          | ProcedureE String [Expr]
           | SetE String Expr
           | ConsE Expr Expr
+          | LambdaE String Expr
           | QuotedE Expr
-          | NilE deriving (Show)
+          | NilE
+          deriving (Show)
 
 -- instance Show Expr where
 --   show (IntE x) = show x

src/Lexer.hs

@@ -12,7 +12,7 @@ parseTokens = do
     return tokns
 
 anyLispToken :: GenParser Char st Token
-anyLispToken = leftParenT <|> rightParenT <|> apostropheT <|> symbolT <|> intT
+anyLispToken = leftParenT <|> rightParenT <|> apostropheT <|> backslashT <|> symbolT <|> intT
 
 ------------------------------------------------------------
 
@@ -30,7 +30,10 @@ apostropheT = char '\'' >> return ApostropheT
 rightParenT :: GenParser Char st Token
 rightParenT = char ')' >> return RightParenT
 
+backslashT :: GenParser Char st Token
+backslashT = char '\\' >> return BackslashT
+
 symbolT :: GenParser Char st Token
 symbolT = do
-    var <- map toLower <$> many1 (letter <|> oneOf "+-*/\\!|@#$~%&/=<>")
+    var <- map toLower <$> many1 (letter <|> oneOf "+-*/!|@#$~%&/=<>")
     return $ SymbolT var

src/Main.hs

@@ -1,6 +1,7 @@
 module Main where
 
 import Evaluator
+import Enviroment
 import Parser
 import Control.Monad
 import Data.Maybe

src/Parser.hs

@@ -20,9 +20,18 @@ expressionFromTokensEOF = do
 
 expressionFromTokens :: GenParser Token st Expr
 expressionFromTokens = do
-  expr <- intE <|> quotedE <|> try setE <|> try nilE <|> try consE <|> varE <|> procedureE
+  expr <- intE <|> quotedE <|> try setE <|> try nilE <|> try consE <|> try lambdaE <|> varE <|> listE
   return expr
 
+listE :: GenParser Token st Expr
+listE = do
+  _ <- parseLeftParenT
+  exprs <- many expressionFromTokens
+  _ <- parseRightParenT
+  return $ toCons exprs
+  where toCons []     = NilE
+        toCons (x:xs) = ConsE x (toCons xs)
+
 intE :: GenParser Token st Expr
 intE = do
     (IntT num) <- parseIntT
@@ -34,14 +43,6 @@ quotedE = do
   expr <- expressionFromTokens
   return $ QuotedE expr
 
-procedureE :: GenParser Token st Expr
-procedureE = do
-  _ <- parseLeftParenT
-  (SymbolT p) <- parseSymbolT
-  args <- many expressionFromTokens
-  _ <- parseRightParenT
-  return $ ProcedureE p args
-
 consE :: GenParser Token st Expr
 consE = do
   _ <- parseLeftParenT
@@ -70,6 +71,14 @@ setE = do
   _ <- parseRightParenT
   return $ SetE var expr
 
+lambdaE :: GenParser Token st Expr
+lambdaE = do
+  _ <- parseBackslashT
+  (SymbolT arg) <- parseSymbolT
+  body <- expressionFromTokens
+  return $ LambdaE arg body
+
+
 ------------------------------------------------------------
 
 satisfyT :: (Stream s m a, Show a) => (a -> Bool) -> ParsecT s u m a
@@ -77,6 +86,9 @@ satisfyT f = tokenPrim show
                        (\pos _ _ -> incSourceColumn pos 1)
                        (\t -> if f t then Just t else Nothing)
 
+parseBackslashT :: GenParser Token st Token
+parseBackslashT = satisfyT (== BackslashT)
+
 parseLeftParenT :: GenParser Token st Token
 parseLeftParenT = satisfyT (== LeftParenT)
 

src/TokenType.hs

@@ -2,6 +2,7 @@ module TokenType where
 
 data Token = LeftParenT
            | RightParenT
+           | BackslashT
            | SymbolT String
            | ApostropheT
            | IntT Integer