From c412d643a1980f89dd7b8c2e05999ed04e3d6c26 Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Sat, 18 Feb 2023 22:13:39 +0100
Subject: [PATCH] macros

---
 app/Builtins.hs | 30 +++++++++++++++++++++++++++++-
 app/Code.hs     |  1 +
 app/Frontend.hs |  1 +
 3 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/app/Builtins.hs b/app/Builtins.hs
index 834adf4..8539562 100644
--- a/app/Builtins.hs
+++ b/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
diff --git a/app/Code.hs b/app/Code.hs
index 709b309..9e1f453 100644
--- a/app/Code.hs
+++ b/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
     }
diff --git a/app/Frontend.hs b/app/Frontend.hs
index 6bae624..990e79d 100644
--- a/app/Frontend.hs
+++ b/app/Frontend.hs
@@ -98,6 +98,7 @@ interpreter =
        , cho = []
        , ops = []
        , opstash = []
+       , macrostash = []
        , strtable = IR.emptystrtable
        , cmdq = []
        })