* boot/ast.boot (%LoadUnit): Add field for enclosing function.

	Remove references to $op.

3 files changed, 59 insertions, 54 deletions

diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index ae24d89c..b977f958 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -152,13 +152,14 @@
   |varno|
   |letno|
   |isno|
-  |sconds|)
+  |sconds|
+  |op|)
 
 (DEFMACRO |mk%LoadUnit|
-          (|fdefs| |sigs| |xports| |csts| |varno| |letno| |isno| |sconds|)
+          (|fdefs| |sigs| |xports| |csts| |varno| |letno| |isno| |sconds| |op|)
   (LIST '|MAKE-%LoadUnit| :|fdefs| |fdefs| :|sigs| |sigs| :|xports| |xports|
         :|csts| |csts| :|varno| |varno| :|letno| |letno| :|isno| |isno|
-        :|sconds| |sconds|))
+        :|sconds| |sconds| :|op| |op|))
 
 (DEFMACRO |functionDefinitions| (|bfVar#1|) (LIST '|%LoadUnit-fdefs| |bfVar#1|))
 
@@ -176,7 +177,9 @@
 
 (DEFMACRO |sideConditions| (|bfVar#1|) (LIST '|%LoadUnit-sconds| |bfVar#1|))
 
-(DEFUN |makeLoadUnit| () (|mk%LoadUnit| NIL NIL NIL NIL 0 0 0 NIL))
+(DEFMACRO |enclosingFunction| (|bfVar#1|) (LIST '|%LoadUnit-op| |bfVar#1|))
+
+(DEFUN |makeLoadUnit| () (|mk%LoadUnit| NIL NIL NIL NIL 0 0 0 NIL NIL))
 
 (DEFUN |pushFunctionDefinition| (|tu| |def|)
   (SETF (|functionDefinitions| |tu|) (CONS |def| (|functionDefinitions| |tu|))))
@@ -839,9 +842,8 @@
            (COND ((EQ (CAR |f|) |e|) (|bfSUBLIS| |p| (CDR |f|)))
                  (T (|bfSUBLIS1| (CDR |p|) |e|)))))))
 
-(DEFUN |defSheepAndGoats| (|x|)
+(DEFUN |defSheepAndGoats| (|tu| |x|)
   (LET* (|defstack| |op1| |opassoc| |argl|)
-    (DECLARE (SPECIAL |$op|))
     (CASE (CAR |x|)
       (|%Definition|
        (LET ((|op| (CADR |x|)) (|args| (CADDR |x|)) (|body| (CADDDR |x|)))
@@ -854,23 +856,24 @@
            (T
             (SETQ |op1|
                     (INTERN
-                     (CONCAT (SYMBOL-NAME |$op|) "," (SYMBOL-NAME |op|))))
+                     (CONCAT (SYMBOL-NAME (|enclosingFunction| |tu|)) ","
+                             (SYMBOL-NAME |op|))))
             (SETQ |opassoc| (LIST (CONS |op| |op1|)))
             (SETQ |defstack| (LIST (LIST |op1| |args| |body|)))
             (LIST |opassoc| |defstack| NIL))))))
       (|%Pile|
        (LET ((|defs| (CADR |x|)))
-         (|defSheepAndGoatsList| |defs|)))
+         (|defSheepAndGoatsList| |tu| |defs|)))
       (T (LIST NIL NIL (LIST |x|))))))
 
-(DEFUN |defSheepAndGoatsList| (|x|)
+(DEFUN |defSheepAndGoatsList| (|tu| |x|)
   (LET* (|nondefs1| |defs1| |opassoc1| |nondefs| |defs| |opassoc| |LETTMP#1|)
     (COND ((NULL |x|) (LIST NIL NIL NIL))
-          (T (SETQ |LETTMP#1| (|defSheepAndGoats| (CAR |x|)))
+          (T (SETQ |LETTMP#1| (|defSheepAndGoats| |tu| (CAR |x|)))
            (SETQ |opassoc| (CAR |LETTMP#1|))
            (SETQ |defs| (CADR . #1=(|LETTMP#1|)))
            (SETQ |nondefs| (CADDR . #1#))
-           (SETQ |LETTMP#1| (|defSheepAndGoatsList| (CDR |x|)))
+           (SETQ |LETTMP#1| (|defSheepAndGoatsList| |tu| (CDR |x|)))
            (SETQ |opassoc1| (CAR |LETTMP#1|))
            (SETQ |defs1| (CADR . #2=(|LETTMP#1|)))
            (SETQ |nondefs1| (CADDR . #2#))
@@ -2073,8 +2076,8 @@
             (|bfMKPROGN| |stmts|))))))
 
 (DEFUN |bfTagged| (|tu| |a| |b|)
-  (DECLARE (SPECIAL |$typings| |$op|))
-  (COND ((NULL |$op|) (|%Signature| |a| |b|))
+  (DECLARE (SPECIAL |$typings|))
+  (COND ((NULL (|enclosingFunction| |tu|)) (|%Signature| |a| |b|))
         ((SYMBOLP |a|)
          (COND ((EQ |b| '|local|) (|bfLET| |tu| (|compFluid| |a|) NIL))
                (T (SETQ |$typings| (CONS (LIST 'TYPE |b| |a|) |$typings|))
@@ -2273,7 +2276,7 @@
 (DEFUN |bfWhere| (|tu| |context| |expr|)
   (LET* (|a| |nondefs| |defs| |opassoc| |LETTMP#1|)
     (PROGN
-     (SETQ |LETTMP#1| (|defSheepAndGoats| |context|))
+     (SETQ |LETTMP#1| (|defSheepAndGoats| |tu| |context|))
      (SETQ |opassoc| (CAR |LETTMP#1|))
      (SETQ |defs| (CADR . #1=(|LETTMP#1|)))
      (SETQ |nondefs| (CADDR . #1#))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 01a10a34..8bd130d9 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -1033,9 +1033,10 @@
        (T (|bpRestore| |ps| |a|) NIL))))))
 
 (DEFUN |bpStoreName| (|ps|)
-  (DECLARE (SPECIAL |$typings| |$op|))
+  (DECLARE (SPECIAL |$typings|))
   (PROGN
-   (SETQ |$op| (CAR (|parserTrees| |ps|)))
+   (SETF (|enclosingFunction| (|parserLoadUnit| |ps|))
+           (CAR (|parserTrees| |ps|)))
    (SETF (|sideConditions| (|parserLoadUnit| |ps|)) NIL)
    (SETQ |$typings| NIL)
    T))
@@ -1376,42 +1377,44 @@
        (|bpPush| |ps| (|bfCaseItem| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
 
 (DEFUN |bpOutItem| (|ps|)
-  (LET* (|t| |r| |ISTMP#2| |l| |ISTMP#1| |b| |varno|)
+  (LET* (|t| |r| |ISTMP#2| |l| |ISTMP#1| |b| |varno| |op|)
     (DECLARE (SPECIAL |$InteractiveMode|))
-    (LET ((|$op| NIL))
-      (DECLARE (SPECIAL |$op|))
-      (PROGN
-       (SETQ |varno| (|parserGensymSequenceNumber| |ps|))
-       (UNWIND-PROTECT
-           (LET ((#1=#:G721
-                  (CATCH :OPEN-AXIOM-CATCH-POINT
-                    (PROGN
-                     (SETF (|parserGensymSequenceNumber| |ps|) 0)
-                     (|bpRequire| |ps| #'|bpComma|)))))
+    (PROGN
+     (SETQ |op| (|enclosingFunction| (|parserLoadUnit| |ps|)))
+     (SETQ |varno| (|parserGensymSequenceNumber| |ps|))
+     (UNWIND-PROTECT
+         (LET ((#1=#:G721
+                (CATCH :OPEN-AXIOM-CATCH-POINT
+                  (PROGN
+                   (SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) NIL)
+                   (SETF (|parserGensymSequenceNumber| |ps|) 0)
+                   (|bpRequire| |ps| #'|bpComma|)))))
+           (COND
+            ((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
              (COND
-              ((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
-               (COND
-                ((EQUAL (CAR #2=(CDR #1#)) '(|BootSpecificError|))
-                 (LET ((|e| (CDR #2#)))
-                   (PROGN (|bpSpecificErrorHere| |ps| |e|) (|bpTrap| |ps|))))
-                (T (THROW :OPEN-AXIOM-CATCH-POINT #1#))))
-              (T #1#)))
-         (SETF (|parserGensymSequenceNumber| |ps|) |varno|))
-       (SETQ |b| (|bpPop1| |ps|))
-       (SETQ |t|
-               (COND ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
-                     ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
-                           (PROGN
-                            (SETQ |ISTMP#1| (CDR |b|))
-                            (AND (CONSP |ISTMP#1|)
-                                 (PROGN
-                                  (SETQ |l| (CAR |ISTMP#1|))
-                                  (SETQ |ISTMP#2| (CDR |ISTMP#1|))
-                                  (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
-                                       (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))
-                           (SYMBOLP |l|))
-                      (COND (|$InteractiveMode| (LIST (LIST 'SETQ |l| |r|)))
-                            (T (LIST (LIST 'DEFPARAMETER |l| |r|)))))
-                     (T (|translateToplevel| |ps| |b| NIL))))
-       (|bpPush| |ps| |t|)))))
+              ((EQUAL (CAR #2=(CDR #1#)) '(|BootSpecificError|))
+               (LET ((|e| (CDR #2#)))
+                 (PROGN (|bpSpecificErrorHere| |ps| |e|) (|bpTrap| |ps|))))
+              (T (THROW :OPEN-AXIOM-CATCH-POINT #1#))))
+            (T #1#)))
+       (PROGN
+        (SETF (|parserGensymSequenceNumber| |ps|) |varno|)
+        (SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) |op|)))
+     (SETQ |b| (|bpPop1| |ps|))
+     (SETQ |t|
+             (COND ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
+                   ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
+                         (PROGN
+                          (SETQ |ISTMP#1| (CDR |b|))
+                          (AND (CONSP |ISTMP#1|)
+                               (PROGN
+                                (SETQ |l| (CAR |ISTMP#1|))
+                                (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                                (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
+                                     (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))
+                         (SYMBOLP |l|))
+                    (COND (|$InteractiveMode| (LIST (LIST 'SETQ |l| |r|)))
+                          (T (LIST (LIST 'DEFPARAMETER |l| |r|)))))
+                   (T (|translateToplevel| |ps| |b| NIL))))
+     (|bpPush| |ps| |t|))))
 
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index afe93b70..a5d81629 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -433,10 +433,9 @@
 
 (DEFUN |shoeOutParse| (|toks|)
   (LET* (|found| |ps|)
-    (DECLARE (SPECIAL |$returns| |$typings| |$op|))
+    (DECLARE (SPECIAL |$returns| |$typings|))
     (PROGN
      (SETQ |ps| (|makeParserState| |toks|))
-     (SETQ |$op| NIL)
      (SETQ |$typings| NIL)
      (SETQ |$returns| NIL)
      (|bpFirstTok| |ps|)