Minor fixes and reworking of the code

cherry-lisp.cabal

@@ -18,9 +18,9 @@ executable cherry
   main-is:             Main.hs
   default-language:    Haskell2010
 
-  other-modules:       ExprType,
+  other-modules:       Expression,
                        Parser,
-                       TokenType,
+                       Token,
                        Lexer,
                        Evaluator,
                        Enviroment

src/Enviroment.hs

@@ -1,16 +1,16 @@
 module Enviroment where
 
 import qualified Data.Map as M
-import ExprType
+import Expression
 import Data.Maybe
 
 data Enviroment = Enviroment (M.Map String Expr) (Maybe Enviroment)
 
+-- The base enviroment, that contains the main functions and variables
 base :: Enviroment
 base = Enviroment (M.fromList [
-  ("test-var", IntE 10),
+  ("id", LambdaE "x" $ VarE "x"),                 -- Given a expression, returns the same expression
-  ("id", LambdaE "x" $ VarE "x"),
+  ("const", LambdaE "x" $ LambdaE "y" $ VarE "x") -- Given two expressions, returns the first expression
-  ("first", LambdaE "x" $ LambdaE "y" $ VarE "x")
   ]) Nothing
 
 lookupVar :: Enviroment -> String -> Maybe Expr
@@ -23,6 +23,7 @@ insertVar (Enviroment menv u) var expr = Enviroment (M.insert var expr menv) u
 emptyEnv :: Enviroment
 emptyEnv = Enviroment M.empty Nothing
 
+-- Returns a copy of the first enviroment whose upper enviroment is the second
 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,6 +1,6 @@
 module Evaluator where
 
-import ExprType
+import Expression
 import Enviroment
 import Data.Maybe
 

src/Expression.hs

@@ -1,4 +1,4 @@
-module ExprType where
+module Expression where
 
 data Expr = IntE Integer
           | VarE String
@@ -8,15 +8,15 @@ data Expr = IntE Integer
           | QuotedE Expr
           | NilE
 
--- Make set! and lambda(?) parsed as cons, detect later set! and lambda as special procedures
+-- TODO: Make set! and lambda(?) parsed as cons, detect later set! and lambda as special procedures
 
 instance Show Expr where
   show (IntE x) = show x
   show (VarE x) = x
-  show (SetE _ _) = "#set"
+  show (SetE v x) = "#[set " ++ show v ++ show x ++ "]"
   show c@(ConsE _ _) = "(" ++ showCons c
-    where showCons (ConsE _ NilE) = ")"
+    where showCons (ConsE x NilE) = show x ++ ")"
           showCons (ConsE x xs)   = show x ++ " " ++ showCons xs
-  show (LambdaE s e) = "#lambda"
+  show (LambdaE s e) = "#[lambda " ++ s ++ " " ++ show e ++ "]"
   show (QuotedE e) = show e
   show NilE     = "nil"

src/Lexer.hs

@@ -1,18 +1,18 @@
 module Lexer where
 
-import Text.ParserCombinators.Parsec
+import Text.ParserCombinators.Parsec hiding (anyToken)
 import Data.Char
-import TokenType
+import Token
 
-parseTokens :: GenParser Char st [Token]
+tokens :: GenParser Char st [Token]
-parseTokens = do
+tokens = do
     _ <-  spaces
-    tokns <- many $ do t <- anyLispToken; spaces; return t
+    tokns <- many $ do t <- anyToken; spaces; return t
     _ <- eof
     return tokns
 
-anyLispToken :: GenParser Char st Token
+anyToken :: GenParser Char st Token
-anyLispToken = leftParenT <|> rightParenT <|> apostropheT <|> backslashT <|> symbolT <|> intT
+anyToken = leftParenT <|> rightParenT <|> apostropheT <|> backslashT <|> symbolT <|> intT
 
 ------------------------------------------------------------
 

src/Parser.hs

@@ -1,32 +1,34 @@
 module Parser where
 
-import Text.Parsec
+import Text.Parsec hiding (tokens)
 import Text.Parsec.String
-import Lexer
+import Lexer (tokens)
-import TokenType
+import Token
-import ExprType
+import Expression
 
 parseExpression :: String -> Either ParseError Expr
 parseExpression s = do
-  tokns <- parse parseTokens "lexical error" s
+  tokns <- parse tokens "lexical error" s
-  expr <- parse expressionFromTokensEOF "parsing error" tokns
+  expr <- parse anyExpressionEOF "parsing error" tokns
   return expr
 
-expressionFromTokensEOF :: GenParser Token st Expr
+anyExpressionEOF :: GenParser Token st Expr
-expressionFromTokensEOF = do
+anyExpressionEOF = do
-  expr <- expressionFromTokens
+  expr <- anyExpression
   _ <- eof
   return expr
 
-expressionFromTokens :: GenParser Token st Expr
+anyExpression :: GenParser Token st Expr
-expressionFromTokens = do
+anyExpression = do
   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
+  exprs <- many anyExpression
   _ <- parseRightParenT
   return $ toCons exprs
   where toCons []     = NilE
@@ -40,15 +42,15 @@ intE = do
 quotedE :: GenParser Token st Expr
 quotedE = do
   _ <- parseApostropheT
-  expr <- expressionFromTokens
+  expr <- anyExpression
   return $ QuotedE expr
 
 consE :: GenParser Token st Expr
 consE = do
   _ <- parseLeftParenT
   _ <- parseConsT
-  expr1 <- expressionFromTokens
+  expr1 <- anyExpression
-  expr2 <- expressionFromTokens
+  expr2 <- anyExpression
   _ <- parseRightParenT
   return $ ConsE expr1 expr2
 
@@ -67,7 +69,7 @@ setE = do
   _ <- parseLeftParenT
   _ <- parseSetT
   (SymbolT var) <- parseSymbolT
-  expr <- expressionFromTokens
+  expr <- anyExpression
   _ <- parseRightParenT
   return $ SetE var expr
 
@@ -75,10 +77,9 @@ lambdaE :: GenParser Token st Expr
 lambdaE = do
   _ <- parseBackslashT
   (SymbolT arg) <- parseSymbolT
-  body <- expressionFromTokens
+  body <- anyExpression
   return $ LambdaE arg body
 
-
 ------------------------------------------------------------
 
 satisfyT :: (Stream s m a, Show a) => (a -> Bool) -> ParsecT s u m a

src/ParserUtils.hs

@@ -1,16 +0,0 @@
--- UNUSED
-module ParserUtils where
-
-import Text.ParserCombinators.Parsec
-import Data.Char
-
-caseInsensitiveString :: String -> GenParser Char st String
-caseInsensitiveString ""     = return ""
-caseInsensitiveString [x]    = (: []) <$> caseInsensitiveChar x
-caseInsensitiveString (x:xs) = do
-    c <- caseInsensitiveChar x
-    s <- caseInsensitiveString xs
-    return (c:s)
-
-caseInsensitiveChar :: Char -> GenParser Char st Char
-caseInsensitiveChar c = char (toLower c) <|> char (toUpper c)

src/Token.hs

@@ -1,4 +1,4 @@
-module TokenType where
+module Token where
 
 data Token = LeftParenT
            | RightParenT