diff --git a/src/BuiltinProcs.hs b/src/BuiltinProcs.hs new file mode 100644 index 0000000..4027ff4 --- /dev/null +++ b/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 diff --git a/src/Enviroment.hs b/src/Enviroment.hs index 40c920f..2af160a 100644 --- a/src/Enviroment.hs +++ b/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 diff --git a/src/Enviroment/Base.hs b/src/Enviroment/Base.hs new file mode 100644 index 0000000..31e75eb --- /dev/null +++ b/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 diff --git a/src/Evaluator.hs b/src/Evaluator.hs index 3812d12..4c0ffc1 100644 --- a/src/Evaluator.hs +++ b/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 diff --git a/src/Main.hs b/src/Main.hs index 1f5885d..92a0bca 100644 --- a/src/Main.hs +++ b/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 diff --git a/src/Parser.hs b/src/Parser.hs index 624ba98..c18d1bf 100644 --- a/src/Parser.hs +++ b/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 diff --git a/src/Types/Language.hs b/src/Types/Language.hs index 6e8567f..2f7a803 100644 --- a/src/Types/Language.hs +++ b/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