aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAkshay <[email protected]>2020-10-17 16:30:07 +0100
committerAkshay <[email protected]>2020-10-17 16:30:07 +0100
commitf68c7f7a140127320f9dadc57a3d2a485b86d3df (patch)
tree983b5967544f898b9b1705a17e3404736c4e5e3f
parent032e26cf9ed236889637e02e56aef7c22721cd23 (diff)
add basic evaluation of unquote-splicing in quasiquoted formsquasiquoting
-rw-r--r--src/Evaluator.hs42
-rw-r--r--src/Parser.hs17
2 files changed, 34 insertions, 25 deletions
diff --git a/src/Evaluator.hs b/src/Evaluator.hs
index 3d3be02..9e6632e 100644
--- a/src/Evaluator.hs
+++ b/src/Evaluator.hs
@@ -16,13 +16,20 @@ apply fn args = maybe
16 ($ args) 16 ($ args)
17 (lookup fn primitives) 17 (lookup fn primitives)
18 18
19evalUnquoteSplicing :: Env -> Expr -> IOResult Expr
20evalUnquoteSplicing env (List xs) = List <$> mapM (eval env) xs
21evalUnquoteSplicing env literal = return literal
22
19evalUnquote :: Env -> Expr -> IOResult Expr 23evalUnquote :: Env -> Expr -> IOResult Expr
20evalUnquote env (List [Id "unquote", vs]) = eval env vs 24evalUnquote env (DottedList h t) = List . (:[]) <$> liftM2 DottedList (mapM (evalUnquote env) h) (evalUnquote env t)
21evalUnquote env (List [Id "quote", vs]) = 25evalUnquote env (Vector vs) = List . (:[]) . Vector <$> mapM (evalUnquote env) vs
22 fmap (List . ([Id "quote"] ++ ) . (: [])) (evalUnquote env vs) 26evalUnquote env (List [Id "unquote", v]) = List . (:[]) <$> eval env v
23evalUnquote env (List vs) = List <$> mapM (evalUnquote env) vs 27evalUnquote env (List [Id "unquote-splicing", v]) = eval env v
24evalUnquote env (Vector vs) = Vector <$> mapM (evalUnquote env) vs 28evalUnquote env (List (Id "unquote-splicing":vs)) = List <$> mapM (eval env) vs
25evalUnquote env literal = return literal 29evalUnquote env (List (Id "unquote":vs)) = List . (:[]) . List <$> mapM (eval env) vs
30evalUnquote env (List [Id "quote", vs]) = List . (:[]) <$> fmap (List . ([Id "quote"] ++ ) . (: [])) (evalUnquote env vs)
31evalUnquote env (List vs) = List . concat <$> mapM ((unwrapList <$>) . evalUnquote env) vs
32evalUnquote env literal = return $ List . (:[]) $ literal
26 33
27evalQuasiQuote :: Env -> Expr -> IOResult Expr 34evalQuasiQuote :: Env -> Expr -> IOResult Expr
28evalQuasiQuote env v@(Vector _) = evalUnquote env v 35evalQuasiQuote env v@(Vector _) = evalUnquote env v
@@ -30,20 +37,23 @@ evalQuasiQuote env q@(List _) = evalUnquote env q -- list of atoms which may b
30evalQuasiQuote env literal = return literal -- just behave like quote otherwise 37evalQuasiQuote env literal = return literal -- just behave like quote otherwise
31 38
32eval :: Env -> Expr -> IOResult Expr 39eval :: Env -> Expr -> IOResult Expr
33eval _ v@(StringLiteral s) = return v 40eval _ v@(StringLiteral s) = return v
34eval _ v@(IntLiteral i) = return v 41eval _ v@(IntLiteral i) = return v
35eval _ v@(BoolLiteral b) = return v 42eval _ v@(BoolLiteral b) = return v
36eval env (Id l) = getVar env l 43eval env (Id l) = getVar env l
37eval _ v@(FloatLiteral f) = return v 44eval _ v@(FloatLiteral f) = return v
38eval env v@(Vector xs) = Vector <$> mapM (eval env) xs 45eval env v@(Vector xs) = Vector <$> mapM (eval env) xs
39eval env (List[Id "quote", val]) = return val 46eval env (List[Id "quote", val]) = return val
40eval env (List[Id "quasiquote", val]) = evalQuasiQuote env val 47eval env (List[Id "quasiquote", val]) = evalQuasiQuote env val
41eval env v@(List[Id "unquote", val]) = throwError $ BadForm "Cannot use `unquote` outside quasiquote form" v 48eval env v@(List[Id "unquote", val]) = throwError $ BadForm "Cannot use `unquote` outside quasiquote form" v
49eval env v@(List[Id "unquote-splicing", val]) = throwError $ BadForm "Cannot use `unquote-splicing` outside quasiquote form" v
42eval env (List [Id "set!", Id var, val]) = eval env val >>= uncurry (*>) . (setVar env var &&& pure) 50eval env (List [Id "set!", Id var, val]) = eval env val >>= uncurry (*>) . (setVar env var &&& pure)
43eval env (List [Id "define", Id var, val]) = eval env val >>= uncurry (*>) . (defineVar env var &&& pure) 51eval env (List [Id "define", Id var, val]) = eval env val >>= uncurry (*>) . (defineVar env var &&& pure)
44eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn 52eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn
45eval env NoReturn = throwError $ BadForm "Invalid usage of non-returning expression" NoReturn
46 53
47-- handle bad forms 54-- handle bad forms
48eval env invalidForm = throwError $ BadForm "lisk can't recognize this form" invalidForm 55eval env invalidForm = throwError $ BadForm "lisk can't recognize this form" invalidForm
49 56
57unwrapList :: Expr -> [Expr]
58unwrapList (List x) = x
59unwrapList literal = [literal]
diff --git a/src/Parser.hs b/src/Parser.hs
index 6ec4ba0..f83f4cc 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -21,7 +21,6 @@ data Expr = List [Expr]
21 | FloatLiteral Double 21 | FloatLiteral Double
22 | BoolLiteral Bool 22 | BoolLiteral Bool
23 | Id String 23 | Id String
24 | NoReturn
25 deriving (Eq) 24 deriving (Eq)
26 25
27-- backslash double quote escapes a quote inside strings 26-- backslash double quote escapes a quote inside strings
@@ -83,15 +82,16 @@ optionalWhiteSpace :: Parser ()
83optionalWhiteSpace = skipMany $ oneOf [' ', '\n'] 82optionalWhiteSpace = skipMany $ oneOf [' ', '\n']
84 83
85type Alias = String 84type Alias = String
86parseModifier :: Char -> Alias -> Parser Expr 85parseModifier :: String -> Alias -> Parser Expr
87parseModifier c alias = do 86parseModifier s alias = do
88 char c 87 string s
89 x <- parseLispValue 88 x <- parseLispValue
90 return $ List [Id alias, x] 89 return $ List [Id alias, x]
91 90
92parseQuote = parseModifier '\'' "quote" 91parseQuote = parseModifier "'" "quote"
93parseQuasiquote = parseModifier '`' "quasiquote" 92parseQuasiquote = parseModifier "`" "quasiquote"
94parseUnquote = parseModifier ',' "unquote" 93parseUnquote = parseModifier "," "unquote"
94parseUnquoteSplicing = parseModifier ",@" "unquote-splicing"
95-- TODO: add modifier for unquote splicing: ,@ 95-- TODO: add modifier for unquote splicing: ,@
96 96
97parseLispValue :: Parser Expr 97parseLispValue :: Parser Expr
@@ -103,8 +103,8 @@ parseLispValue =
103 <|> try parseId 103 <|> try parseId
104 <|> parseQuote 104 <|> parseQuote
105 <|> parseQuasiquote 105 <|> parseQuasiquote
106 <|> try parseUnquoteSplicing
106 <|> parseUnquote 107 <|> parseUnquote
107 -- handles lists and dotted lists
108 <|> do 108 <|> do
109 char '(' >> optionalWhiteSpace 109 char '(' >> optionalWhiteSpace
110 x <- sepEndBy parseLispValue whiteSpace 110 x <- sepEndBy parseLispValue whiteSpace
@@ -127,4 +127,3 @@ instance Show Expr where
127 show (BoolLiteral True) = "#t" 127 show (BoolLiteral True) = "#t"
128 show (BoolLiteral False) = "#f" 128 show (BoolLiteral False) = "#f"
129 show (Id i) = i 129 show (Id i) = i
130 show NoReturn = ";;; environment extension"