Added car, cdr and cons builtin procs

src/BuiltinProcs.hs

@@ -0,0 +1,13 @@
+module BuiltinProcs where
+
+import Types.Language
+import Control.Monad.State
+
+car :: [Expr] -> State Enviroment Expr
+car [ConsE x _] = return $ QuotedE x
+
+cdr :: [Expr] -> State Enviroment Expr
+cdr [ConsE _ xs] = return $ QuotedE xs
+
+cons :: [Expr] -> State Enviroment Expr
+cons [e1, e2] = return $ QuotedE $ ConsE e1 e2

src/Enviroment.hs

@@ -4,13 +4,6 @@ import qualified Data.Map as M
 import Types.Language
 import Data.Maybe
 
--- The base enviroment, that contains the main functions and variables
-base :: Enviroment
-base = Enviroment (M.fromList [
-  ("id", LambdaE "x" $ VarE "x"),                 -- Given a expression, returns the same expression
-  ("const", LambdaE "x" $ LambdaE "y" $ VarE "x") -- Given two expressions, returns the first expression
-  ]) Nothing
-
 lookupVar :: String -> Enviroment -> Maybe Expr
 lookupVar var (Enviroment menv upperEnv) = let mExpr = M.lookup var menv in
   if isNothing mExpr then upperEnv >>= lookupVar var else mExpr

src/Enviroment/Base.hs

@@ -0,0 +1,14 @@
+module Enviroment.Base where
+
+import BuiltinProcs
+import Types.Language
+import Data.Map as M
+
+base :: Enviroment
+base = Enviroment (M.fromList [
+  ("id", LambdaE "x" $ VarE "x"),                  -- Given a expression, returns the same expression
+  ("const", LambdaE "x" $ LambdaE "y" $ VarE "x"), -- Given two expressions, returns the first expression
+  ("car", BuiltinProcE car),
+  ("cdr", BuiltinProcE cdr),
+  ("cons", BuiltinProcE cons)
+  ]) Nothing

src/Evaluator.hs

@@ -22,6 +22,7 @@ evalS (ConsE pr args) = do
   finalExpr <- evalS resExpr
   return finalExpr
 evalS l@(LambdaE _ _) = return l
+evalS p@(BuiltinProcE _) = return p
 evalS NilE = return NilE
 
 applyS :: Expr -> Expr -> State Enviroment Expr
@@ -29,4 +30,8 @@ applyS (LambdaE p expr) (ConsE x xs) = do
   e <- applyS expr xs
   get >>= put . (`extendEnv` insertVar p x emptyEnv)
   return e
+applyS (BuiltinProcE p) args = do
+  args' <- mapM evalS $ cons2List args
+  e <- p args'
+  return e
 applyS e NilE = return e

src/Main.hs

@@ -1,8 +1,8 @@
 module Main where
 
 import Evaluator
-import Enviroment
 import Parser
+import Enviroment.Base
 import Control.Monad
 import Data.Maybe
 import System.Console.Haskeline

src/Parser.hs

@@ -20,7 +20,7 @@ anyExpressionEOF = do
 
 anyExpression :: GenParser Token st Expr
 anyExpression = do
-  expr <- intE <|> quotedE <|> try setE <|> try nilE <|> try consE <|> try lambdaE <|> varE <|> listE
+  expr <- intE <|> quotedE <|> try setE <|> try nilE <|> try lambdaE <|> varE <|> listE
   return expr
 
 ------------------------------------------------------------
@@ -45,15 +45,6 @@ quotedE = do
   expr <- anyExpression
   return $ QuotedE expr
 
-consE :: GenParser Token st Expr
-consE = do
-  _ <- parseLeftParenT
-  _ <- parseConsT
-  expr1 <- anyExpression
-  expr2 <- anyExpression
-  _ <- parseRightParenT
-  return $ ConsE expr1 expr2
-
 varE :: GenParser Token st Expr
 varE = do
   (SymbolT var) <- parseSymbolT
@@ -109,11 +100,6 @@ parseNilT = satisfyT isNilT
   where isNilT (SymbolT "nil") = True
         isNilT _               = False
 
-parseConsT :: GenParser Token st Token
-parseConsT = satisfyT isConsT
-  where isConsT (SymbolT "cons") = True
-        isConsT _               = False
-
 parseSymbolT :: GenParser Token st Token
 parseSymbolT = satisfyT isSymbolT
   where isSymbolT (SymbolT _) = True

src/Types/Language.hs

@@ -1,6 +1,7 @@
 module Types.Language where
 
 import Data.Map (Map)
+import Control.Monad.State
 
 data Enviroment = Enviroment (Map String Expr) (Maybe Enviroment)
 
@@ -9,6 +10,7 @@ data Expr = IntE Integer
           | SetE String Expr
           | ConsE Expr Expr
           | LambdaE String Expr
+          | BuiltinProcE ([Expr] -> State Enviroment Expr)
           | QuotedE Expr
           | NilE
 
@@ -18,9 +20,13 @@ instance Show Expr where
   show (SetE v x) = "#[set " ++ show v ++ show x ++ "]"
   show c@(ConsE _ _) = "(" ++ showCons c
     where showCons (ConsE x NilE) = show x ++ ")"
-          showCons (ConsE x xs)   = show x ++ " " ++ showCons xs
+          showCons (ConsE x xs)   = show x ++ " " ++ show xs ++ ")"
   show (LambdaE s e) = "#[lambda " ++ s ++ " " ++ show e ++ "]"
-  show (QuotedE e) = show e
+  show (QuotedE e) = "Q" ++ show e
   show NilE     = "nil"
 
+cons2List :: Expr -> [Expr]
+cons2List NilE = []
+cons2List (ConsE x xs) = x:cons2List xs
+
 -- TODO: Make set! and lambda(?) parsed as cons, detect later set! and lambda as special procedures