macros

app/Builtins.hs

@@ -301,11 +301,36 @@ popOps :: InterpFn
 popOps = do
   currentOps <- gets opstash
   case currentOps of
-    [] -> prlgError "no op stash to pop"
+    [] -> prlgError "no ops stashed"
     (ops':opss) -> do
       modify $ \s -> s {ops = ops', opstash = opss}
       continue
 
+{- expansion environment -}
+stashExpansions :: InterpFn
+stashExpansions = do
+  ds <- gets defs
+  les <- findStruct "load_expansion" 2
+  qes <- findStruct "query_expansion" 2
+  let [le, qe] = map (ds M.!?) [les, qes]
+  modify $ \s -> s {macrostash = (le, qe) : macrostash s}
+  continue
+
+popExpansions :: InterpFn
+popExpansions = do
+  currentMacros <- gets macrostash
+  les <- findStruct "load_expansion" 2
+  qes <- findStruct "query_expansion" 2
+  case currentMacros of
+    [] -> prlgError "no expansions stashed"
+    ((le, qe):stash') -> do
+      modify $ \s ->
+        s
+          { defs = M.alter (const le) les $ M.alter (const qe) qes $ defs s
+          , macrostash = stash'
+          }
+      continue
+
 {- adding the builtins -}
 addOp :: (String, O.Op) -> PrlgEnv ()
 addOp op = modify $ \s -> s {ops = op : ops s}
@@ -394,6 +419,9 @@ addPrelude = do
   addBi deop "deop" 1
   addBi stashOps "stash_operators" 0
   addBi popOps "pop_operators" 0
+  {- macroenvironment -}
+  addBi stashExpansions "stash_expansions" 0
+  addBi popExpansions "pop_expansions" 0
   {- query tools -}
   addBi printLocals "print_locals" 0
   addBi promptRetry' "prompt_retry" 0

app/Code.hs

@@ -62,6 +62,7 @@ data Interp =
     , cho :: [Cho] -- remaining choice points
     , ops :: Ops -- currently defined operators
     , opstash :: [Ops] -- saved operators
+    , macrostash :: [(Maybe [Code], Maybe [Code])] -- saved expansion defs (load, query)
     , strtable :: StrTable -- string table
     , cmdq :: [(Bool, PAST)] -- isQuery, lexemes
     }

app/Frontend.hs

@@ -98,6 +98,7 @@ interpreter =
        , cho = []
        , ops = []
        , opstash = []
+       , macrostash = []
        , strtable = IR.emptystrtable
        , cmdq = []
        })