Move compiler macro's to separate module (from Compiler)

4 files changed, 56 insertions, 48 deletions

diff --git a/Compiler.hs b/Compiler.hs
index 37f3d0d..f973afa 100644
--- a/Compiler.hs
+++ b/Compiler.hs
@@ -24,50 +24,6 @@ data TaggedValue
     | TVEllipsis
   deriving Show
 
-preprocess :: Value -> Value
-preprocess (VList [VName "define", VName name, VList args, body])
-    | Just names <- mapM fromVName args = preprocess (VList [VName "define", VName name, VLambda names body])
-    | otherwise = error "Invalid 'define' shorthand syntax: Invalid argument list"
-preprocess (VList [VName "define", VName name, value]) = VDefine name (preprocess value)
-preprocess (VList (VName "define" : _)) = error "Invalid 'define' syntax"
-
-preprocess (VList [VName "lambda", VList args, body])
-    | Just names <- mapM fromVName args = preprocess (VLambda names body)
-    | otherwise = error "Invalid 'lambda' syntax: Invalid argument list"
-preprocess (VList (VName "lambda" : _)) = error "Invalid 'lambda' syntax"
-
-preprocess (VList [VName "lambdarec", VName recname, VList args, body])
-    | Just names <- mapM fromVName args = preprocess (VLambdaRec recname names body)
-    | otherwise = error "Invalid 'lambdarec' syntax: Invalid argument list"
-preprocess (VList (VName "lambdarec" : _)) = error "Invalid 'lambdarec' syntax"
-
--- preprocess (VList [VName "let", VList args, body]) =
---     case sequence [case p of { [n, v] -> Just (n, v); _ -> Nothing } | VList p <- args] of
---         Just pairs ->
---             preprocess (VList (VList [VName "lambda", VList (map fst pairs), body] : map snd pairs))
---         Nothing ->
---             error "Invalid 'let' syntax: Invalid variable list (not all pairs)"
-preprocess (VList [VName "let", VList args, body]) =
-    case sequence [case p of { [VName n, v] -> Just (n, v); _ -> Nothing } | VList p <- args] of
-        Just pairs ->
-            preprocess (VLet pairs body)
-        Nothing ->
-            error "Invalid 'let' syntax: Invalid variable list (not all pairs)"
-preprocess (VList (VName "let" : _)) = error "Invalid 'let' syntax: Invalid argument list"
-
-preprocess (VList values) = VList (map preprocess values)
-
-preprocess (VDefine name body) = VDefine name (preprocess body)
-preprocess (VLambda args body) = VLambda args (preprocess body)
-preprocess (VLambdaRec recname args body) = VLambdaRec recname args (preprocess body)
-preprocess (VLet args body) = VLet [(name, preprocess value) | (name, value) <- args] (preprocess body)
-preprocess v@(VNum _) = v
-preprocess v@(VString _) = v
-preprocess v@(VName _) = v
-preprocess v@(VQuoted _) = v
-preprocess v@(VBuiltin _) = v
-preprocess v@VEllipsis = v
-
 analyseValue :: Value -> TaggedValue
 analyseValue = go (Map.empty, 0)
   where
@@ -213,8 +169,7 @@ compileProgram (Program values) = runCM $ do
     bstart <- newBlockSwitch
     forM_ values $ \value -> do
         bnext <- newBlock
-        let value' = preprocess value
-            tvalue = analyseValue value'
+        let tvalue = analyseValue value
         ref <- genTValue tvalue bnext
         switchBlock bnext
         addIns (RNone, IDiscard ref)
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
diff --git a/Main.hs b/Main.hs
index ef98b62..70991c0 100644
--- a/Main.hs
+++ b/Main.hs
@@ -5,6 +5,7 @@ import System.Environment
 import System.Exit
 
 import Compiler
+import CompilerMacros
 import Optimiser
 import Parser
 import VM
@@ -23,7 +24,8 @@ main = do
         _ -> usage >> exitFailure
 
     prog <- parseProgram mfname source >>= either (die . show) return
-    irprog <- either die return (compileProgram prog)
+    let prog' = compilerMacros prog
+    irprog <- either die return (compileProgram prog')
     let opt = optimise irprog
     -- print opt
     vmRun opt
diff --git a/lisphs.cabal b/lisphs.cabal
index 83d844d..b054466 100644
--- a/lisphs.cabal
+++ b/lisphs.cabal
@@ -13,4 +13,4 @@ executable            lisp
     ghc-options:      -Wall -O2
     build-depends:    base >= 4 && < 5,
                       containers, filepath, mtl, parsec
-    other-modules:    AST, Compiler, Intermediate, Optimiser, Parser, VM
+    other-modules:    AST, Compiler, CompilerMacros, Intermediate, Optimiser, Parser, VM