diff options
-rw-r--r-- | src/Base.hs | 26 | ||||
-rw-r--r-- | src/Parser.hs | 10 |
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 @@ | |||
1 | module Base (Expr (..) | 1 | module Base (Expr (..) |
2 | , Env (..) | 2 | , Env (..) |
3 | , Function (..) | ||
4 | ) where | 3 | ) where |
5 | 4 | ||
6 | import Data.IORef | 5 | import 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 | ||
21 | data Function = | 20 | data 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 | |||
31 | showLispList = unwords . map show | 30 | showLispList = unwords . map show |
32 | 31 | ||
33 | instance Show Expr where | 32 | instance 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 | ||
9 | import Base (Expr (..), Function) | 10 | import Base (Expr (..)) |
10 | import Control.Applicative ((<$>)) | 11 | import Control.Applicative ((<$>)) |
11 | import Text.ParserCombinators.Parsec | 12 | import 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 | ||
66 | parseComment :: Parser () | ||
67 | parseComment = char ';' >> manyTill anyChar (char '\n') >> return () | ||
68 | |||
65 | whiteSpace :: Parser () | 69 | whiteSpace :: Parser () |
66 | whiteSpace = skipMany1 $ oneOf [' ', '\n'] | 70 | whiteSpace = parseComment <|> (skipMany1 $ oneOf [' ', '\n']) |
67 | 71 | ||
68 | optionalWhiteSpace :: Parser () | 72 | optionalWhiteSpace :: Parser () |
69 | optionalWhiteSpace = skipMany $ oneOf [' ', '\n'] | 73 | optionalWhiteSpace = parseComment <|> (skipMany $ oneOf [' ', '\n']) |
70 | 74 | ||
71 | type Alias = String | 75 | type Alias = String |
72 | parseModifier :: String -> Alias -> Parser Expr | 76 | parseModifier :: String -> Alias -> Parser Expr |