summaryrefslogtreecommitdiff
path: root/CompilerMacros.hs
diff options
context:
space:
mode:
authorTom Smeding <tom.smeding@gmail.com>2019-11-20 22:51:12 +0100
committerTom Smeding <tom.smeding@gmail.com>2019-11-20 23:06:45 +0100
commitbee62a7f1ac399fa1641711ecbbca46b66adcfc4 (patch)
treee5ae692e7d921bfc914b872522d30a7d12d6f2ac /CompilerMacros.hs
parentd541e0f84ae8f82f70e2393207d359975841facf (diff)
Move compiler macro's to separate module (from Compiler)
Diffstat (limited to 'CompilerMacros.hs')
-rw-r--r--CompilerMacros.hs51
1 files changed, 51 insertions, 0 deletions
diff --git a/CompilerMacros.hs b/CompilerMacros.hs
new file mode 100644
index 0000000..610e659
--- /dev/null
+++ b/CompilerMacros.hs
@@ -0,0 +1,51 @@
+module CompilerMacros(compilerMacros) where
+
+import AST
+
+
+compilerMacros :: Program -> Program
+compilerMacros (Program values) = Program (map process values)
+
+process :: Value -> Value
+process (VList [VName "define", VName name, VList args, body])
+ | Just names <- mapM fromVName args = process (VList [VName "define", VName name, VLambda names body])
+ | otherwise = error "Invalid 'define' shorthand syntax: Invalid argument list"
+process (VList [VName "define", VName name, value]) = VDefine name (process value)
+process (VList (VName "define" : _)) = error "Invalid 'define' syntax"
+
+process (VList [VName "lambda", VList args, body])
+ | Just names <- mapM fromVName args = process (VLambda names body)
+ | otherwise = error "Invalid 'lambda' syntax: Invalid argument list"
+process (VList (VName "lambda" : _)) = error "Invalid 'lambda' syntax"
+
+process (VList [VName "lambdarec", VName recname, VList args, body])
+ | Just names <- mapM fromVName args = process (VLambdaRec recname names body)
+ | otherwise = error "Invalid 'lambdarec' syntax: Invalid argument list"
+process (VList (VName "lambdarec" : _)) = error "Invalid 'lambdarec' syntax"
+
+-- process (VList [VName "let", VList args, body]) =
+-- case sequence [case p of { [n, v] -> Just (n, v); _ -> Nothing } | VList p <- args] of
+-- Just pairs ->
+-- process (VList (VList [VName "lambda", VList (map fst pairs), body] : map snd pairs))
+-- Nothing ->
+-- error "Invalid 'let' syntax: Invalid variable list (not all pairs)"
+process (VList [VName "let", VList args, body]) =
+ case sequence [case p of { [VName n, v] -> Just (n, v); _ -> Nothing } | VList p <- args] of
+ Just pairs ->
+ process (VLet pairs body)
+ Nothing ->
+ error "Invalid 'let' syntax: Invalid variable list (not all pairs)"
+process (VList (VName "let" : _)) = error "Invalid 'let' syntax: Invalid argument list"
+
+process (VList values) = VList (map process values)
+
+process (VDefine name body) = VDefine name (process body)
+process (VLambda args body) = VLambda args (process body)
+process (VLambdaRec recname args body) = VLambdaRec recname args (process body)
+process (VLet args body) = VLet [(name, process value) | (name, value) <- args] (process body)
+process v@(VNum _) = v
+process v@(VString _) = v
+process v@(VName _) = v
+process v@(VQuoted _) = v
+process v@(VBuiltin _) = v
+process v@VEllipsis = v