Created a function to divert variables back to the compiled program, and added calls to it after macro expansion via macroEval and expand.

Author: Justin

hs-src/Language/Scheme/Compiler.hs

@@ -214,24 +214,13 @@ compile env (List [Atom "expand",  _body]) copts = do
   val <- Language.Scheme.Macro.expand env False _body Language.Scheme.Core.apply
   compileScalar (" return $ " ++ astToHaskellStr val) copts
 
-compile env (List (Atom "let-syntax" : List _bindings : _body)) copts@(CompileOptions tfnc uvar uargs nfnc) = do
+compile env (List (Atom "let-syntax" : List _bindings : _body)) copts = do
   -- TODO: check if let-syntax has been rebound?
   bodyEnv <- liftIO $ extendEnv env []
   _ <- Language.Scheme.Macro.loadMacros env bodyEnv Nothing False _bindings
   -- Expand whole body as a single continuous macro, to ensure hygiene
   expanded <- Language.Scheme.Macro.expand bodyEnv False (List _body) Language.Scheme.Core.apply
-
--- TODO: should be able to consolidate with the one from macroEval
--- also, need to use for the other 'expand' call below
-  vars <- Language.Scheme.Macro.getDivertedVars bodyEnv
-  case vars of 
-    [] -> func bodyEnv expanded copts
-    _ -> do 
-      Atom symNext <- _gensym "afterDivert"
-      diverted <- compileDivertedVars symNext bodyEnv vars copts
-      rest <- func bodyEnv expanded $ CompileOptions symNext uvar uargs nfnc
-      return $ [diverted] ++ rest
-
+  divertVars bodyEnv expanded copts func
  where 
    func bodyEnv' expanded' copts' = do
      case expanded' of
@@ -244,9 +233,12 @@ compile env (List (Atom "letrec-syntax" : List _bindings : _body)) copts = do
   _ <- Language.Scheme.Macro.loadMacros bodyEnv bodyEnv Nothing False _bindings
   -- Expand whole body as a single continuous macro, to ensure hygiene
   expanded <- Language.Scheme.Macro.expand bodyEnv False (List _body) Language.Scheme.Core.apply
-  case expanded of
-    List e -> compile bodyEnv (List $ Atom "begin" : e) copts
-    e -> compile bodyEnv e copts
+  divertVars bodyEnv expanded copts func
+ where 
+   func bodyEnv' expanded' copts' = do
+     case expanded' of
+       List e -> compile bodyEnv' (List $ Atom "begin" : e) copts'
+       e -> compile bodyEnv' e copts'
 
 compile env (List [Atom "define-syntax", Atom keyword,
   (List [Atom "er-macro-transformer", 
@@ -659,17 +651,32 @@ compile _ badForm _ = throwError $ BadSpecialForm "Unrecognized special form" ba
 mcompile :: Env -> LispVal -> CompOpts -> IOThrowsError [HaskAST]
 mcompile env lisp copts = mfunc env lisp compile copts
 mfunc :: Env -> LispVal -> (Env -> LispVal -> CompOpts -> IOThrowsError [HaskAST]) -> CompOpts -> IOThrowsError [HaskAST] 
-mfunc env lisp func copts@(CompileOptions tfnc uvar uargs nfnc) = do
-
-  transformed <- Language.Scheme.Macro.macroEval env lisp Language.Scheme.Core.apply
-
+mfunc env lisp func copts = do
+  expanded <- Language.Scheme.Macro.macroEval env lisp Language.Scheme.Core.apply
+  divertVars env expanded copts func
+
+-- |Do the actual insertion of diverted variables back to the 
+--  compiled program.
+divertVars :: 
+    Env ->
+    -- ^Current compile Environment
+    LispVal ->
+    -- ^Lisp code after macro expansion
+    CompOpts ->
+    -- ^Compiler options
+    (Env -> LispVal -> CompOpts -> IOThrowsError [HaskAST]) ->
+    -- ^Continuation to call into after vars are diverted
+    IOThrowsError [HaskAST]
+    -- ^Code generated by the continuation, along with the code
+    --  added to divert vars to the compiled program
+divertVars env expanded copts@(CompileOptions tfnc uvar uargs nfnc) func = do
   vars <- Language.Scheme.Macro.getDivertedVars env
   case vars of 
-    [] -> func env transformed copts
+    [] -> func env expanded copts
     _ -> do 
       Atom symNext <- _gensym "afterDivert"
       diverted <- compileDivertedVars symNext env vars copts
-      rest <- func env transformed $ CompileOptions symNext uvar uargs nfnc
+      rest <- func env expanded $ CompileOptions symNext uvar uargs nfnc
       return $ [diverted] ++ rest
 
 -- |Take a list of variables diverted into env at compile time, and