summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTom Smeding <tom.smeding@gmail.com>2019-11-14 17:31:23 +0100
committerTom Smeding <tom.smeding@gmail.com>2019-11-14 17:32:14 +0100
commit551f74a3f77d5f0b7b5221fa38ef67df5790083f (patch)
tree74fb6f6b985173f6c304bfae0961892e7e4f4ddb
parentd3a9d62b5866771489cdc9f4e0fced3e7845eb9c (diff)
Implement 'let'
-rw-r--r--AST.hs2
-rw-r--r--Compiler.hs8
2 files changed, 10 insertions, 0 deletions
diff --git a/AST.hs b/AST.hs
index eae5af8..df946dd 100644
--- a/AST.hs
+++ b/AST.hs
@@ -14,6 +14,7 @@ data Value
| VName Name
| VQuoted Value
| VLambda [Name] Value
+ | VLet [(Name, Value)] Value
| VBuiltin String
| VEllipsis
deriving (Eq)
@@ -29,6 +30,7 @@ instance Show Value where
show (VName n) = n
show (VQuoted e) = '\'' : show e
show (VLambda as v) = "(lambda (" ++ intercalate " " as ++ ") " ++ show v ++ ")"
+ show (VLet ps v) = "(let (" ++ intercalate " " ["(" ++ n ++ " " ++ show w ++ ")" | (n, w) <- ps] ++ ") " ++ show v ++ ")"
show (VBuiltin str) = "[[builtin " ++ str ++ "]]"
show VEllipsis = "..."
diff --git a/Compiler.hs b/Compiler.hs
index 9f8b595..a5a1f3d 100644
--- a/Compiler.hs
+++ b/Compiler.hs
@@ -36,6 +36,13 @@ analyseValue = go []
| Just names <- mapM fromVName args = go scopes (VLambda names body)
| otherwise = error "Invalid 'lambda' syntax: Invalid argument list"
go _ (VList (VName "lambda" : _)) = error "Invalid 'lambda' syntax"
+ go scopes (VList [VName "let", VList args, body]) =
+ case sequence [if length p == 2 then Just (p !! 0, p !! 1) else Nothing | VList p <- args] of
+ Just pairs ->
+ go scopes (VList (VList [VName "lambda", VList (map fst pairs), body] : map snd pairs))
+ Nothing ->
+ error "Invalid 'let' syntax: Invalid variable list (not all pairs)"
+ go _ (VList (VName "let" : _)) = error "Invalid 'let' syntax: Invalid argument list"
go scopes (VList values) = TVList (map (go scopes) values)
go _ (VNum n) = TVNum n
go _ (VString s) = TVString s
@@ -46,6 +53,7 @@ analyseValue = go []
in TVLambda args t (Set.toList (collectEscapes 0 t))
go _ (VBuiltin _) = undefined
go _ VEllipsis = TVEllipsis
+ go _ (VLet _ _) = error "'let' should not be present yet at this point"
collectEscapes :: Int -> TaggedValue -> Set.Set Name
collectEscapes limit (TVList values) = Set.unions (map (collectEscapes limit) values)