execute macro actions in phase 1

src/Expander.hs

@@ -410,7 +410,7 @@
       [ ( "open-syntax"
         , Scheme [] $ tFun [tSyntax] (Prims.primitiveDatatype "Syntax-Contents" [tSyntax])
         , ValueClosure $ HO $
           \(ValueSyntax stx) ->
             case syntaxE stx of
               Id name ->
                 primitiveCtor "identifier-contents" [ValueString name]
@@ -428,9 +428,9 @@
         , Scheme [] $
           tFun [tSyntax, tSyntax, Prims.primitiveDatatype "Syntax-Contents" [tSyntax]] tSyntax
         , ValueClosure $ HO $
           \(ValueSyntax locStx) ->
             ValueClosure $ HO $
             \(ValueSyntax scopesStx) ->
               ValueClosure $ HO $
               -- N.B. Assuming correct constructors
               \(ValueCtor ctor [arg]) ->
@@ -1306,7 +1306,7 @@
                           ValueSyntax $ addScope p stepScope stx
               case macroVal of
                 ValueMacroAction act -> do
-                  res <- interpretMacroAction prob act
+                  res <- inEarlierPhase $ interpretMacroAction prob act
                   case res of
                     StuckOnType loc ty env cases kont ->
                       forkAwaitingTypeCase loc prob ty env cases kont
@@ -1432,8 +1432,8 @@
         getIdent (ValueSyntax stx) = mustBeIdent stx
         getIdent _other = throwError $ InternalError $ "Not a syntax object in " ++ opName
         compareFree id1 id2 = do
-          b1 <- resolve id1
-          b2 <- resolve id2
+          b1 <- inLaterPhase $ resolve id1
+          b2 <- inLaterPhase $ resolve id2
           return $ Done $
             flip primitiveCtor [] $
             if b1 == b2 then "true" else "false"

src/Expander/Monad.hs

@@ -45,6 +45,7 @@ module Expander.Monad
   , getDecl
   , getState
   , inEarlierPhase
+  , inLaterPhase
   , inPhase
   , isExprChecked
   , importing
@@ -407,6 +408,10 @@ inEarlierPhase :: Expand a -> Expand a
 inEarlierPhase act =
   Expand $ local (over (expanderLocal . expanderPhase) prior) $ runExpand act
 
+inLaterPhase :: Expand a -> Expand a
+inLaterPhase act =
+  Expand $ local (over (expanderLocal . expanderPhase) posterior) $ runExpand act
+
 moduleScope :: ModuleName -> Expand Scope
 moduleScope mn = moduleScope' mn
 

src/Phase.hs

@@ -3,7 +3,7 @@
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
-module Phase (Phase(..), runtime, prior, Phased(..)) where
+module Phase (Phase(..), runtime, prior, posterior, Phased(..)) where
 
 import Control.Lens
 import Data.Data (Data)
@@ -34,6 +34,9 @@ runtime = Phase 0
 prior :: Phase -> Phase
 prior (Phase i) = Phase (i + 1)
 
+posterior :: Phase -> Phase
+posterior (Phase i) = Phase (i - 1)
+
 class Phased a where
   shift :: Natural -> a -> a