aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Base.hs26
-rw-r--r--src/Parser.hs10
2 files changed, 20 insertions, 16 deletions
diff --git a/src/Base.hs b/src/Base.hs
index 08131e8..8defd91 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -1,6 +1,5 @@
1module Base (Expr (..) 1module Base (Expr (..)
2 , Env (..) 2 , Env (..)
3 , Function (..)
4 ) where 3 ) where
5 4
6import Data.IORef 5import Data.IORef
@@ -16,10 +15,10 @@ data Expr = List [Expr]
16 | FloatLiteral Double 15 | FloatLiteral Double
17 | BoolLiteral Bool 16 | BoolLiteral Bool
18 | Id String 17 | Id String
19 deriving (Eq) 18 | Function Fn
20 19
21data Function = 20data Fn =
22 Function { 21 Fn {
23 params :: [String] 22 params :: [String]
24 , body :: Expr 23 , body :: Expr
25 , environment :: Env 24 , environment :: Env
@@ -31,12 +30,13 @@ showLispList :: [Expr] -> String
31showLispList = unwords . map show 30showLispList = unwords . map show
32 31
33instance Show Expr where 32instance Show Expr where
34 show (DottedList xs x) = "(" ++ showLispList xs ++ " . " ++ show x ++ ")" 33 show (DottedList xs x) = "(" ++ showLispList xs ++ " . " ++ show x ++ ")"
35 show (List xs) = "(" ++ showLispList xs ++ ")" 34 show (List xs) = "(" ++ showLispList xs ++ ")"
36 show (Vector xs) = "#(" ++ showLispList xs ++ ")" 35 show (Vector xs) = "#(" ++ showLispList xs ++ ")"
37 show (StringLiteral s) = "\"" ++ s ++ "\"" 36 show (StringLiteral s) = "\"" ++ s ++ "\""
38 show (IntLiteral n) = show n 37 show (IntLiteral n) = show n
39 show (FloatLiteral n) = show n 38 show (FloatLiteral n) = show n
40 show (BoolLiteral True) = "#t" 39 show (BoolLiteral True) = "#t"
41 show (BoolLiteral False) = "#f" 40 show (BoolLiteral False) = "#f"
42 show (Id i) = i 41 show (Id i) = i
42 show (Function (Fn params body env)) = "<#procedure " ++ unwords params ++ ">"
diff --git a/src/Parser.hs b/src/Parser.hs
index 94de680..6247843 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -2,11 +2,12 @@ module Parser ( parseLispValue
2 , parseString 2 , parseString
3 , parseInt 3 , parseInt
4 , parseFloat 4 , parseFloat
5 , parseComment
5 , parseId 6 , parseId
6 , parseQuote 7 , parseQuote
7 ) where 8 ) where
8 9
9import Base (Expr (..), Function) 10import Base (Expr (..))
10import Control.Applicative ((<$>)) 11import Control.Applicative ((<$>))
11import Text.ParserCombinators.Parsec 12import Text.ParserCombinators.Parsec
12 13
@@ -62,11 +63,14 @@ parseId = do
62 "#f" -> BoolLiteral False 63 "#f" -> BoolLiteral False
63 _ -> Id atom 64 _ -> Id atom
64 65
66parseComment :: Parser ()
67parseComment = char ';' >> manyTill anyChar (char '\n') >> return ()
68
65whiteSpace :: Parser () 69whiteSpace :: Parser ()
66whiteSpace = skipMany1 $ oneOf [' ', '\n'] 70whiteSpace = parseComment <|> (skipMany1 $ oneOf [' ', '\n'])
67 71
68optionalWhiteSpace :: Parser () 72optionalWhiteSpace :: Parser ()
69optionalWhiteSpace = skipMany $ oneOf [' ', '\n'] 73optionalWhiteSpace = parseComment <|> (skipMany $ oneOf [' ', '\n'])
70 74
71type Alias = String 75type Alias = String
72parseModifier :: String -> Alias -> Parser Expr 76parseModifier :: String -> Alias -> Parser Expr