* interp/lexing.boot (stackClear!): Fix typo.

	Add new grammar reduction abstract datatype facility.
	* interp/fnewmeta.lisp: Use it.
	* interp/parsing.lisp: Likewise.
	* interp/bootlex.lisp (SPAD): Use popStack1.
	* interp/spad-parser.boot (parseSpadFile): Likewise.
	* interp/metalex.lisp: Remove REDUCTION and associated functions.

8 files changed, 280 insertions, 278 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 8c11fae0..31d4aa5d 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,15 @@
 2011-10-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/lexing.boot (stackClear!): Fix typo.
+	Add new grammar reduction abstract datatype facility.
+	* interp/fnewmeta.lisp: Use it.
+	* interp/parsing.lisp: Likewise.
+	* interp/bootlex.lisp (SPAD): Use popStack1.
+	* interp/spad-parser.boot (parseSpadFile): Likewise.
+	* interp/metalex.lisp: Remove REDUCTION and associated functions.
+
+2011-10-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/lexing.boot: New.
 	* interp/metalex.lisp: Include it.  Use new stack datatype support.
 	* interp/parsing.lisp: Use new stack datatype support.
diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp
index 31022c0a..c3e5d4c0 100644
--- a/src/interp/bootlex.lisp
+++ b/src/interp/bootlex.lisp
@@ -122,7 +122,7 @@
              (let ((LINE (cdar Boot-Line-Stack)))
                (declare (special LINE))
                (|PARSE-NewExpr|)
-               (let ((parseout (pop-stack-1)) )
+               (let ((parseout (|popStack1|)) )
                  (when parseout
                        (let ((|$OutputStream| out-stream))
                          (S-PROCESS parseout))
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
index 28c9e03c..44650661 100644
--- a/src/interp/fnewmeta.lisp
+++ b/src/interp/fnewmeta.lisp
@@ -60,7 +60,7 @@
 (DEFUN |PARSE-Command| ()
   (AND (MATCH-ADVANCE-STRING ")") (MUST (|PARSE-SpecialKeyWord|))
        (MUST (|PARSE-SpecialCommand|))
-       (PUSH-REDUCTION '|PARSE-Command| NIL))) 
+       (|pushReduction| '|PARSE-Command| NIL))) 
 
 
 (DEFUN |PARSE-SpecialKeyWord| ()
@@ -75,8 +75,8 @@
                  (OPTIONAL
                      (OR (MATCH-ADVANCE-STRING "?")
                          (|PARSE-Expression|))))
-           (PUSH-REDUCTION '|PARSE-SpecialCommand|
-               (CONS '|show| (CONS (POP-STACK-1) NIL)))
+           (|pushReduction| '|PARSE-SpecialCommand|
+               (CONS '|show| (CONS (|popStack1|) NIL)))
            (MUST (|PARSE-CommandTail|)))
       (AND (MEMBER (CURRENT-SYMBOL) |$noParseCommands|)
            (ACTION (FUNCALL (CURRENT-SYMBOL))))
@@ -89,16 +89,16 @@
 (DEFUN |PARSE-TokenList| ()
   (STAR REPEATOR
         (AND (NOT (|isTokenDelimiter|))
-             (PUSH-REDUCTION '|PARSE-TokenList| (CURRENT-SYMBOL))
+             (|pushReduction| '|PARSE-TokenList| (CURRENT-SYMBOL))
              (ACTION (ADVANCE-TOKEN))))) 
 
 
 (DEFUN |PARSE-TokenCommandTail| ()
   (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-TokenOption|))))
        (|atEndOfLine|)
-       (PUSH-REDUCTION '|PARSE-TokenCommandTail|
-           (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))
-       (ACTION (|systemCommand| (POP-STACK-1))))) 
+       (|pushReduction| '|PARSE-TokenCommandTail|
+           (CONS (|popStack2|) (APPEND (|popStack1|) NIL)))
+       (ACTION (|systemCommand| (|popStack1|))))) 
 
 
 (DEFUN |PARSE-TokenOption| ()
@@ -108,14 +108,14 @@
 (DEFUN |PARSE-CommandTail| ()
   (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Option|))))
        (|atEndOfLine|)
-       (PUSH-REDUCTION '|PARSE-CommandTail|
-           (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))
-       (ACTION (|systemCommand| (POP-STACK-1))))) 
+       (|pushReduction| '|PARSE-CommandTail|
+           (CONS (|popStack2|) (APPEND (|popStack1|) NIL)))
+       (ACTION (|systemCommand| (|popStack1|))))) 
 
 
 (DEFUN |PARSE-PrimaryOrQM| ()
   (OR (AND (MATCH-ADVANCE-STRING "?")
-           (PUSH-REDUCTION '|PARSE-PrimaryOrQM| '?))
+           (|pushReduction| '|PARSE-PrimaryOrQM| '?))
       (|PARSE-Primary|))) 
 
 
@@ -130,22 +130,22 @@
            (AND (STAR REPEATOR
                       (AND (MATCH-ADVANCE-STRING ",")
                            (MUST (|PARSE-Expr| 0))))
-                (PUSH-REDUCTION '|PARSE-Statement|
+                (|pushReduction| '|PARSE-Statement|
                     (CONS '|Series|
-                          (CONS (POP-STACK-2)
-                                (APPEND (POP-STACK-1) NIL)))))))) 
+                          (CONS (|popStack2|)
+                                (APPEND (|popStack1|) NIL)))))))) 
 
 
 (DEFUN |PARSE-InfixWith| ()
   (AND (|PARSE-With|)
-       (PUSH-REDUCTION '|PARSE-InfixWith|
-           (CONS '|Join| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
+       (|pushReduction| '|PARSE-InfixWith|
+           (CONS '|Join| (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) 
 
 
 (DEFUN |PARSE-With| ()
   (AND (MATCH-ADVANCE-KEYWORD "with") (MUST (|PARSE-Category|))
-       (PUSH-REDUCTION '|PARSE-With|
-           (CONS '|with| (CONS (POP-STACK-1) NIL))))) 
+       (|pushReduction| '|PARSE-With|
+           (CONS '|with| (CONS (|popStack1|) NIL))))) 
 
 
 (DEFUN |PARSE-Category| ()
@@ -158,11 +158,11 @@
                      (OPTIONAL
                          (AND (MATCH-ADVANCE-KEYWORD "else")
                               (MUST (|PARSE-Category|)))))
-               (PUSH-REDUCTION '|PARSE-Category|
+               (|pushReduction| '|PARSE-Category|
                    (CONS '|if|
-                         (CONS (POP-STACK-3)
-                               (CONS (POP-STACK-2)
-                                     (CONS (POP-STACK-1) NIL))))))
+                         (CONS (|popStack3|)
+                               (CONS (|popStack2|)
+                                     (CONS (|popStack1|) NIL))))))
           (AND (MATCH-ADVANCE-STRING "(") (MUST (|PARSE-Category|))
                (BANG FIL_TEST
                      (OPTIONAL
@@ -170,33 +170,33 @@
                                (AND (MATCH-ADVANCE-STRING ";")
                                     (MUST (|PARSE-Category|))))))
                (MUST (MATCH-ADVANCE-STRING ")"))
-               (PUSH-REDUCTION '|PARSE-Category|
+               (|pushReduction| '|PARSE-Category|
                    (CONS 'CATEGORY
-                         (CONS (POP-STACK-2)
-                               (APPEND (POP-STACK-1) NIL)))))
+                         (CONS (|popStack2|)
+                               (APPEND (|popStack1|) NIL)))))
           (AND (ACTION (SETQ G1 (LINE-NUMBER CURRENT-LINE)))
                (OR (|PARSE-Application|)
 		   (|PARSE-OperatorFunctionName|))
                (MUST (OR (AND (MATCH-ADVANCE-STRING ":")
                               (MUST (|PARSE-Expression|))
-                              (PUSH-REDUCTION '|PARSE-Category|
+                              (|pushReduction| '|PARSE-Category|
                                   (CONS '|%Signature|
-                                        (CONS (POP-STACK-2)
-                                         (CONS (POP-STACK-1) NIL))))
+                                        (CONS (|popStack2|)
+                                         (CONS (|popStack1|) NIL))))
                               (ACTION (|recordSignatureDocumentation|
-                                       (NTH-STACK 1) G1)))
-                         (AND (PUSH-REDUCTION '|PARSE-Category|
+                                       (|nthStack| 1) G1)))
+                         (AND (|pushReduction| '|PARSE-Category|
                                   (CONS '|%Attribute|
-                                        (CONS (POP-STACK-1) NIL)))
+                                        (CONS (|popStack1|) NIL)))
                               (ACTION (|recordAttributeDocumentation|
-                                       (NTH-STACK 1) G1)))))))))) 
+                                       (|nthStack| 1) G1)))))))))) 
 
 
 (DEFUN |PARSE-Expression| ()
   (AND (|PARSE-Expr|
            (|PARSE-rightBindingPowerOf| (MAKE-SYMBOL-OF PRIOR-TOKEN)
                |ParseMode|))
-       (PUSH-REDUCTION '|PARSE-Expression| (POP-STACK-1)))) 
+       (|pushReduction| '|PARSE-Expression| (|popStack1|)))) 
 
 
 (DEFUN |PARSE-Import| ()
@@ -206,19 +206,19 @@
                 (MUST (|PARSE-Expression|))
                 (MUST (MATCH-ADVANCE-KEYWORD "from"))
                 (MUST (|PARSE-Expr| 1000))
-                (PUSH-REDUCTION '|PARSE-Import|
+                (|pushReduction| '|PARSE-Import|
 		    (CONS '|%SignatureImport|
-			  (CONS (POP-STACK-3)
-				(CONS (POP-STACK-2)
-				      (CONS (POP-STACK-1) NIL))))))
+			  (CONS (|popStack3|)
+				(CONS (|popStack2|)
+				      (CONS (|popStack1|) NIL))))))
            (AND (BANG FIL_TEST
 		      (OPTIONAL
 		       (STAR REPEATOR
 			     (AND (MATCH-ADVANCE-STRING ",")
 				  (MUST (|PARSE-Expr| 1000))))))
-		(PUSH-REDUCTION '|PARSE-Import|
+		(|pushReduction| '|PARSE-Import|
                     (CONS '|import|
-			  (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL))))))))
+			  (CONS (|popStack2|) (APPEND (|popStack1|) NIL))))))))
 
 ;; domain inlining.  Same syntax as import directive; except
 ;; deliberate restriction on naming one type at a time.
@@ -226,8 +226,8 @@
 (DEFUN |PARSE-Inline| ()
   (AND (MATCH-ADVANCE-KEYWORD "inline")
        (MUST (|PARSE-Expr| 1000))
-       (PUSH-REDUCTION '|PARSE-Inline|
-           (CONS '|%Inline| (CONS (POP-STACK-1) NIL)))))
+       (|pushReduction| '|PARSE-Inline|
+           (CONS '|%Inline| (CONS (|popStack1|) NIL)))))
 
 ;; quantified types.  At the moment, these are used only in
 ;; pattern-mathing cases.
@@ -237,17 +237,17 @@
 	   (MUST (|PARSE-QuantifiedVariableList|))
 	   (MUST (MATCH-ADVANCE-STRING "."))
 	   (MUST (|PARSE-Expr| 200))
-	   (MUST (PUSH-REDUCTION '|PARSE-Forall|
-				 (CONS (POP-STACK-3)
-				       (CONS (POP-STACK-2)
-					     (CONS (POP-STACK-1) NIL))))))
+	   (MUST (|pushReduction| '|PARSE-Forall|
+				 (CONS (|popStack3|)
+				       (CONS (|popStack2|)
+					     (CONS (|popStack1|) NIL))))))
       (|PARSE-Application|)))
 
 (DEFUN |PARSE-Quantifier| ()
   (OR (AND (MATCH-ADVANCE-KEYWORD "forall")
-	   (MUST (PUSH-REDUCTION '|PARSE-Quantifier| '|%Forall|)))
+	   (MUST (|pushReduction| '|PARSE-Quantifier| '|%Forall|)))
       (AND (MATCH-ADVANCE-KEYWORD "exist")
-	   (MUST (PUSH-REDUCTION '|PARSE-Quantifier| '|%Exist|)))))
+	   (MUST (|pushReduction| '|PARSE-Quantifier| '|%Exist|)))))
 
 (DEFUN |PARSE-QuantifiedVariableList| ()
   (AND (MATCH-ADVANCE-STRING "(")
@@ -256,43 +256,43 @@
 	(AND (STAR REPEATOR 
 		   (AND (MATCH-ADVANCE-STRING ",")
 			(MUST (|PARSE-QuantifiedVariable|))))
-	     (PUSH-REDUCTION '|PARSE-QuantifiedVariableList|
+	     (|pushReduction| '|PARSE-QuantifiedVariableList|
 			     (CONS '|%Sequence|
-				   (CONS (POP-STACK-2) 
-					 (APPEND (POP-STACK-1) NIL))))))
+				   (CONS (|popStack2|) 
+					 (APPEND (|popStack1|) NIL))))))
        (MUST (MATCH-ADVANCE-STRING ")"))))
 
 (DEFUN |PARSE-QuantifiedVariable| ()
   (AND (|PARSE-Name|)
        (MUST (MATCH-ADVANCE-STRING ":"))
        (MUST (|PARSE-Application|))
-       (MUST (PUSH-REDUCTION '|PARSE-QuantifiedVariable|
+       (MUST (|pushReduction| '|PARSE-QuantifiedVariable|
 			     (CONS '|:| 
-				   (CONS (POP-STACK-2)
-					 (CONS (POP-STACK-1) NIL)))))))
+				   (CONS (|popStack2|)
+					 (CONS (|popStack1|) NIL)))))))
 
 (DEFUN |PARSE-Infix| ()
-  (AND (PUSH-REDUCTION '|PARSE-Infix| (CURRENT-SYMBOL))
+  (AND (|pushReduction| '|PARSE-Infix| (CURRENT-SYMBOL))
        (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|))
        (MUST (|PARSE-Expression|))
-       (PUSH-REDUCTION '|PARSE-Infix|
-           (CONS (POP-STACK-2)
-                 (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
+       (|pushReduction| '|PARSE-Infix|
+           (CONS (|popStack2|)
+                 (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) 
 
 
 (DEFUN |PARSE-Prefix| ()
-  (AND (PUSH-REDUCTION '|PARSE-Prefix| (CURRENT-SYMBOL))
+  (AND (|pushReduction| '|PARSE-Prefix| (CURRENT-SYMBOL))
        (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|))
        (MUST (|PARSE-Expression|))
-       (PUSH-REDUCTION '|PARSE-Prefix|
-           (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))) 
+       (|pushReduction| '|PARSE-Prefix|
+           (CONS (|popStack2|) (CONS (|popStack1|) NIL))))) 
 
 
 (DEFUN |PARSE-Suffix| ()
-  (AND (PUSH-REDUCTION '|PARSE-Suffix| (CURRENT-SYMBOL))
+  (AND (|pushReduction| '|PARSE-Suffix| (CURRENT-SYMBOL))
        (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|))
-       (PUSH-REDUCTION '|PARSE-Suffix|
-           (CONS (POP-STACK-1) (CONS (POP-STACK-1) NIL))))) 
+       (|pushReduction| '|PARSE-Suffix|
+           (CONS (|popStack1|) (CONS (|popStack1|) NIL))))) 
 
 
 (DEFUN |PARSE-TokTail| ()
@@ -309,28 +309,28 @@
 
 (DEFUN |PARSE-Qualification| ()
   (AND (MATCH-ADVANCE-STRING "$") (MUST (|PARSE-Primary1|))
-       (PUSH-REDUCTION '|PARSE-Qualification|
-           (|dollarTran| (POP-STACK-1) (POP-STACK-1))))) 
+       (|pushReduction| '|PARSE-Qualification|
+           (|dollarTran| (|popStack1|) (|popStack1|))))) 
 
 
 (DEFUN |PARSE-SemiColon| ()
   (AND (MATCH-ADVANCE-STRING ";")
        (MUST (OR (|PARSE-Expr| 82)
-                 (PUSH-REDUCTION '|PARSE-SemiColon| '|/throwAway|)))
-       (PUSH-REDUCTION '|PARSE-SemiColon|
-           (CONS '|;| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
+                 (|pushReduction| '|PARSE-SemiColon| '|/throwAway|)))
+       (|pushReduction| '|PARSE-SemiColon|
+           (CONS '|;| (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) 
 
 ;; We should factorize these boilerplates
 (DEFUN |PARSE-Return| ()
   (AND (MATCH-ADVANCE-KEYWORD "return") (MUST (|PARSE-Expression|))
-       (PUSH-REDUCTION '|PARSE-Return|
-           (CONS '|return| (CONS (POP-STACK-1) NIL))))) 
+       (|pushReduction| '|PARSE-Return|
+           (CONS '|return| (CONS (|popStack1|) NIL))))) 
 
 (DEFUN |PARSE-Throw| ()
   (AND (MATCH-ADVANCE-KEYWORD "throw")
        (MUST (|PARSE-Expression|))
-       (PUSH-REDUCTION '|PARSE-Throw|
-           (CONS '|%Throw| (CONS (POP-STACK-1) NIL))))) 
+       (|pushReduction| '|PARSE-Throw|
+           (CONS '|%Throw| (CONS (|popStack1|) NIL))))) 
 
 (DEFUN |PARSE-Catch| ()
   (AND (MATCH-SPECIAL ";")
@@ -342,9 +342,9 @@
        (MUST (MATCH-ADVANCE-SPECIAL ")"))
        (MUST (|PARSE-GlyphTok| "=>"))
        (MUST (|PARSE-Expression|))
-       (PUSH-REDUCTION '|PARSE-Catch|
-	  (CONS (POP-STACK-2)
-		(CONS (POP-STACK-1) NIL)))))
+       (|pushReduction| '|PARSE-Catch|
+	  (CONS (|popStack2|)
+		(CONS (|popStack1|) NIL)))))
 
 (DEFUN |PARSE-Finally| ()
   (AND (MATCH-SPECIAL ";")
@@ -360,19 +360,19 @@
        ;; a series of catch-expressions optionally followed by
        ;; a finally-expression.
        (MUST (OR (AND (|PARSE-Finally|)
-		      (PUSH-REDUCTION '|PARSE-Try|
+		      (|pushReduction| '|PARSE-Try|
                          (CONS '|%Try| 
-			       (CONS (POP-STACK-2)
+			       (CONS (|popStack2|)
 				     (CONS NIL
-					   (CONS (POP-STACK-1) NIL))))))
+					   (CONS (|popStack1|) NIL))))))
 		 (AND (MUST (STAR REPEATOR (|PARSE-Catch|)))
 		      (BANG FIL_TEST
 			    (OPTIONAL (|PARSE-Finally|)))
-		      (PUSH-REDUCTION '|PARSE-Try|
+		      (|pushReduction| '|PARSE-Try|
                          (CONS '|%Try|
-			       (CONS (POP-STACK-3)
-				     (CONS (POP-STACK-2)
-					   (CONS (POP-STACK-1) 
+			       (CONS (|popStack3|)
+				     (CONS (|popStack2|)
+					   (CONS (|popStack1|) 
 						 NIL))))))))))
 
 
@@ -380,31 +380,31 @@
   (LET ((S (CURRENT-SYMBOL)))
        (AND S 
 	    (ACTION (ADVANCE-TOKEN))
-	    (PUSH-REDUCTION '|PARSE-Jump| S))))
+	    (|pushReduction| '|PARSE-Jump| S))))
 
 
 (DEFUN |PARSE-Exit| ()
   (AND (MATCH-ADVANCE-KEYWORD "exit")
        (MUST (OR (|PARSE-Expression|)
-                 (PUSH-REDUCTION '|PARSE-Exit| '|$NoValue|)))
-       (PUSH-REDUCTION '|PARSE-Exit|
-           (CONS '|exit| (CONS (POP-STACK-1) NIL)))))
+                 (|pushReduction| '|PARSE-Exit| '|$NoValue|)))
+       (|pushReduction| '|PARSE-Exit|
+           (CONS '|exit| (CONS (|popStack1|) NIL)))))
 
 
 (DEFUN |PARSE-Leave| ()
   (AND (MATCH-ADVANCE-KEYWORD "leave")
        (MUST (OR (|PARSE-Expression|)
-                 (PUSH-REDUCTION '|PARSE-Leave| '|$NoValue|)))
-       (MUST (PUSH-REDUCTION '|PARSE-Leave|
-                 (CONS '|leave| (CONS (POP-STACK-1) NIL))))))
+                 (|pushReduction| '|PARSE-Leave| '|$NoValue|)))
+       (MUST (|pushReduction| '|PARSE-Leave|
+                 (CONS '|leave| (CONS (|popStack1|) NIL))))))
 
 
 (DEFUN |PARSE-Seg| ()
   (AND (|PARSE-GlyphTok| "..")
        (BANG FIL_TEST (OPTIONAL (|PARSE-Expression|)))
-       (PUSH-REDUCTION '|PARSE-Seg|
+       (|pushReduction| '|PARSE-Seg|
            (CONS 'SEGMENT
-                 (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
+                 (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) 
 
 
 (DEFUN |PARSE-Conditional| ()
@@ -414,10 +414,10 @@
              (OPTIONAL
                  (AND (MATCH-ADVANCE-KEYWORD "else")
                       (MUST (|PARSE-ElseClause|)))))
-       (PUSH-REDUCTION '|PARSE-Conditional|
+       (|pushReduction| '|PARSE-Conditional|
            (CONS '|if|
-                 (CONS (POP-STACK-3)
-                       (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) 
+                 (CONS (|popStack3|)
+                       (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) 
 
 
 (DEFUN |PARSE-ElseClause| ()
@@ -429,22 +429,22 @@
   (OR (AND (STAR REPEATOR (|PARSE-Iterator|))
            (MUST (MATCH-ADVANCE-KEYWORD "repeat"))
            (MUST (|PARSE-Expr| 110))
-           (PUSH-REDUCTION '|PARSE-Loop|
+           (|pushReduction| '|PARSE-Loop|
                (CONS 'REPEAT
-                     (APPEND (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))
+                     (APPEND (|popStack2|) (CONS (|popStack1|) NIL)))))
       (AND (MATCH-ADVANCE-KEYWORD "repeat") (MUST (|PARSE-Expr| 110))
-           (PUSH-REDUCTION '|PARSE-Loop|
-               (CONS 'REPEAT (CONS (POP-STACK-1) NIL)))))) 
+           (|pushReduction| '|PARSE-Loop|
+               (CONS 'REPEAT (CONS (|popStack1|) NIL)))))) 
 
 
 (DEFUN |PARSE-Variable| ()
   (OR (AND (|PARSE-Name|)
 	   (OPTIONAL (AND (MATCH-ADVANCE-STRING ":")
 			  (MUST (|PARSE-Application|))
-			  (MUST (PUSH-REDUCTION '|PARSE-Variable|
+			  (MUST (|pushReduction| '|PARSE-Variable|
 				   (CONS '|:| 
-				      (CONS (POP-STACK-2)
-					    (CONS (POP-STACK-1) NIL))))))))
+				      (CONS (|popStack2|)
+					    (CONS (|popStack1|) NIL))))))))
       (|PARSE-Primary|)))
 
 (DEFUN |PARSE-Iterator| ()
@@ -453,26 +453,26 @@
            (MUST (|PARSE-Expression|))
            (MUST (OR (AND (MATCH-ADVANCE-KEYWORD "by")
                           (MUST (|PARSE-Expr| 200))
-                          (PUSH-REDUCTION '|PARSE-Iterator|
+                          (|pushReduction| '|PARSE-Iterator|
                               (CONS 'INBY
-                                    (CONS (POP-STACK-3)
-                                     (CONS (POP-STACK-2)
-                                      (CONS (POP-STACK-1) NIL))))))
-                     (PUSH-REDUCTION '|PARSE-Iterator|
+                                    (CONS (|popStack3|)
+                                     (CONS (|popStack2|)
+                                      (CONS (|popStack1|) NIL))))))
+                     (|pushReduction| '|PARSE-Iterator|
                          (CONS 'IN
-                               (CONS (POP-STACK-2)
-                                     (CONS (POP-STACK-1) NIL))))))
+                               (CONS (|popStack2|)
+                                     (CONS (|popStack1|) NIL))))))
            (OPTIONAL
                (AND (MATCH-ADVANCE-STRING "|")
                     (MUST (|PARSE-Expr| 111))
-                    (PUSH-REDUCTION '|PARSE-Iterator|
-                        (CONS '|\|| (CONS (POP-STACK-1) NIL))))))
+                    (|pushReduction| '|PARSE-Iterator|
+                        (CONS '|\|| (CONS (|popStack1|) NIL))))))
       (AND (MATCH-ADVANCE-KEYWORD "while") (MUST (|PARSE-Expr| 190))
-           (PUSH-REDUCTION '|PARSE-Iterator|
-               (CONS 'WHILE (CONS (POP-STACK-1) NIL))))
+           (|pushReduction| '|PARSE-Iterator|
+               (CONS 'WHILE (CONS (|popStack1|) NIL))))
       (AND (MATCH-ADVANCE-KEYWORD "until") (MUST (|PARSE-Expr| 190))
-           (PUSH-REDUCTION '|PARSE-Iterator|
-               (CONS 'UNTIL (CONS (POP-STACK-1) NIL)))))) 
+           (|pushReduction| '|PARSE-Iterator|
+               (CONS 'UNTIL (CONS (|popStack1|) NIL)))))) 
 
 
 (DEFUN |PARSE-Match| ()
@@ -480,16 +480,16 @@
        (MUST (|PARSE-Expr| 400))
        (MATCH-ADVANCE-KEYWORD "is")
        (MUST (|PARSE-Expr| 110))
-       (PUSH-REDUCTION '|PARSE-Match|
+       (|pushReduction| '|PARSE-Match|
 		       (CONS '|%Match|
-			     (CONS (POP-STACK-2)
-				   (CONS (POP-STACK-1) NIL))))))
+			     (CONS (|popStack2|)
+				   (CONS (|popStack1|) NIL))))))
 
 (DEFUN |PARSE-Expr| (RBP)
   (DECLARE (SPECIAL RBP))
   (AND (|PARSE-NudPart| RBP)
        (OPTIONAL (STAR OPT_EXPR (|PARSE-LedPart| RBP)))
-       (PUSH-REDUCTION '|PARSE-Expr| (POP-STACK-1)))) 
+       (|pushReduction| '|PARSE-Expr| (|popStack1|)))) 
 
 
 (DEFUN |PARSE-Label| ()
@@ -500,14 +500,14 @@
 (DEFUN |PARSE-LedPart| (RBP)
   (DECLARE (SPECIAL RBP))
   (AND (|PARSE-Operation| '|Led| RBP)
-       (PUSH-REDUCTION '|PARSE-LedPart| (POP-STACK-1)))) 
+       (|pushReduction| '|PARSE-LedPart| (|popStack1|)))) 
 
 
 (DEFUN |PARSE-NudPart| (RBP)
   (DECLARE (SPECIAL RBP))
   (AND (OR (|PARSE-Operation| '|Nud| RBP) (|PARSE-Reduction|)
            (|PARSE-Form|))
-       (PUSH-REDUCTION '|PARSE-NudPart| (POP-STACK-1)))) 
+       (|pushReduction| '|PARSE-NudPart| (|popStack1|)))) 
 
 
 (DEFUN |PARSE-Operation| (|ParseMode| RBP)
@@ -539,15 +539,15 @@
 
 (DEFUN |PARSE-Reduction| ()
   (AND (|PARSE-ReductionOp|) (MUST (|PARSE-Expr| 1000))
-       (PUSH-REDUCTION '|PARSE-Reduction|
+       (|pushReduction| '|PARSE-Reduction|
            (CONS '|%Reduce|
-                 (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) 
+                 (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) 
 
 
 (DEFUN |PARSE-ReductionOp| ()
   (AND (GETL (CURRENT-SYMBOL) '|Led|)
        (MATCH-NEXT-TOKEN 'GLIPH '/)
-       (PUSH-REDUCTION '|PARSE-ReductionOp| (CURRENT-SYMBOL))
+       (|pushReduction| '|PARSE-ReductionOp| (CURRENT-SYMBOL))
        (ACTION (ADVANCE-TOKEN)) (ACTION (ADVANCE-TOKEN)))) 
 
 
@@ -557,13 +557,13 @@
                  (OPTIONAL
                      (AND (MATCH-ADVANCE-KEYWORD "from")
                           (MUST (|PARSE-Label|))
-                          (PUSH-REDUCTION '|PARSE-Form|
-                              (CONS (POP-STACK-1) NIL)))))
-           (PUSH-REDUCTION '|PARSE-Form|
-               (CONS '|iterate| (APPEND (POP-STACK-1) NIL))))
+                          (|pushReduction| '|PARSE-Form|
+                              (CONS (|popStack1|) NIL)))))
+           (|pushReduction| '|PARSE-Form|
+               (CONS '|iterate| (APPEND (|popStack1|) NIL))))
       (AND (MATCH-ADVANCE-KEYWORD "yield") (MUST (|PARSE-Application|))
-           (PUSH-REDUCTION '|PARSE-Form|
-               (CONS '|yield| (CONS (POP-STACK-1) NIL))))
+           (|pushReduction| '|PARSE-Form|
+               (CONS '|yield| (CONS (|popStack1|) NIL))))
       (|PARSE-Application|))) 
 
 
@@ -571,21 +571,21 @@
   (AND (|PARSE-Primary|) (OPTIONAL (STAR OPT_EXPR (|PARSE-Selector|)))
        (OPTIONAL
            (AND (|PARSE-Application|)
-                (PUSH-REDUCTION '|PARSE-Application|
-                    (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) 
+                (|pushReduction| '|PARSE-Application|
+                    (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) 
 
 
 (DEFUN |PARSE-Selector| ()
   (OR (AND NONBLANK (EQ (CURRENT-SYMBOL) '|.|)
            (CHAR-NE (CURRENT-CHAR) '| |) (MATCH-ADVANCE-STRING ".")
            (MUST (|PARSE-PrimaryNoFloat|))
-           (MUST (PUSH-REDUCTION '|PARSE-Selector|
-                     (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))
+           (MUST (|pushReduction| '|PARSE-Selector|
+                     (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))
       (AND (OR (|PARSE-Float|)
                (AND (MATCH-ADVANCE-STRING ".")
                     (MUST (|PARSE-Primary|))))
-           (MUST (PUSH-REDUCTION '|PARSE-Selector|
-                     (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) 
+           (MUST (|pushReduction| '|PARSE-Selector|
+                     (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) 
 
 
 (DEFUN |PARSE-PrimaryNoFloat| ()
@@ -601,23 +601,23 @@
            (OPTIONAL
                (AND NONBLANK (EQ (CURRENT-SYMBOL) '|(|)
                     (MUST (|PARSE-Primary1|))
-                    (PUSH-REDUCTION '|PARSE-Primary1|
-                        (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+                    (|pushReduction| '|PARSE-Primary1|
+                        (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))
       (|PARSE-Quad|) (|PARSE-String|) (|PARSE-IntegerTok|)
       (|PARSE-FormalParameter|)
       (AND (MATCH-ADVANCE-STRING "'")
            (MUST (AND (MUST (|PARSE-Data|))
-                      (PUSH-REDUCTION '|PARSE-Primary1| (POP-STACK-1)))))
+                      (|pushReduction| '|PARSE-Primary1| (|popStack1|)))))
       (|PARSE-Sequence|) (|PARSE-Enclosure|))) 
 
 
 (DEFUN |PARSE-Float| ()
   (AND (|PARSE-FloatBase|)
        (MUST (OR (AND NONBLANK (|PARSE-FloatExponent|))
-                 (PUSH-REDUCTION '|PARSE-Float| 0)))
-       (PUSH-REDUCTION '|PARSE-Float|
-           (MAKE-FLOAT (POP-STACK-4) (POP-STACK-2) (POP-STACK-2)
-               (POP-STACK-1))))) 
+                 (|pushReduction| '|PARSE-Float| 0)))
+       (|pushReduction| '|PARSE-Float|
+           (MAKE-FLOAT (|popStack4|) (|popStack2|) (|popStack2|)
+               (|popStack1|))))) 
 
 
 (DEFUN |PARSE-FloatBase| ()
@@ -626,21 +626,21 @@
            (MUST (|PARSE-FloatBasePart|)))
       (AND (INTEGERP (CURRENT-SYMBOL))
            (CHAR-EQ (CHAR-UPCASE (CURRENT-CHAR)) 'E)
-           (|PARSE-IntegerTok|) (PUSH-REDUCTION '|PARSE-FloatBase| 0)
-           (PUSH-REDUCTION '|PARSE-FloatBase| 0))
+           (|PARSE-IntegerTok|) (|pushReduction| '|PARSE-FloatBase| 0)
+           (|pushReduction| '|PARSE-FloatBase| 0))
       (AND (DIGITP (CURRENT-CHAR)) (EQ (CURRENT-SYMBOL) '|.|)
-           (PUSH-REDUCTION '|PARSE-FloatBase| 0)
+           (|pushReduction| '|PARSE-FloatBase| 0)
            (|PARSE-FloatBasePart|)))) 
 
 
 (DEFUN |PARSE-FloatBasePart| ()
   (AND (MATCH-ADVANCE-STRING ".")
        (MUST (OR (AND (DIGITP (CURRENT-CHAR))
-                      (PUSH-REDUCTION '|PARSE-FloatBasePart|
+                      (|pushReduction| '|PARSE-FloatBasePart|
                           (TOKEN-NONBLANK (CURRENT-TOKEN)))
                       (|PARSE-IntegerTok|))
-                 (AND (PUSH-REDUCTION '|PARSE-FloatBasePart| 0)
-                      (PUSH-REDUCTION '|PARSE-FloatBasePart| 0)))))) 
+                 (AND (|pushReduction| '|PARSE-FloatBasePart| 0)
+                      (|pushReduction| '|PARSE-FloatBasePart| 0)))))) 
 
 
 (DEFUN |PARSE-FloatExponent| ()
@@ -653,13 +653,13 @@
                               (MUST (|PARSE-IntegerTok|)))
                          (AND (MATCH-ADVANCE-STRING "-")
                               (MUST (|PARSE-IntegerTok|))
-                              (PUSH-REDUCTION '|PARSE-FloatExponent|
-                                  (MINUS (POP-STACK-1))))
-                         (PUSH-REDUCTION '|PARSE-FloatExponent| 0))))
+                              (|pushReduction| '|PARSE-FloatExponent|
+                                  (MINUS (|popStack1|))))
+                         (|pushReduction| '|PARSE-FloatExponent| 0))))
           (AND (IDENTP (CURRENT-SYMBOL))
                (SETQ G1 (FLOATEXPID (CURRENT-SYMBOL)))
                (ACTION (ADVANCE-TOKEN))
-               (PUSH-REDUCTION '|PARSE-FloatExponent| G1)))))) 
+               (|pushReduction| '|PARSE-FloatExponent| G1)))))) 
 
 
 (DEFUN |PARSE-Enclosure| ()
@@ -667,26 +667,26 @@
            (MUST (OR (AND (|PARSE-Expr| 6)
                           (MUST (MATCH-ADVANCE-STRING ")")))
                      (AND (MATCH-ADVANCE-STRING ")")
-                          (PUSH-REDUCTION '|PARSE-Enclosure|
+                          (|pushReduction| '|PARSE-Enclosure|
                               (CONS '|%Comma| NIL))))))
       (AND (MATCH-ADVANCE-STRING "{")
            (MUST (OR (AND (|PARSE-Expr| 6)
                           (MUST (MATCH-ADVANCE-STRING "}"))
-                          (PUSH-REDUCTION '|PARSE-Enclosure|
+                          (|pushReduction| '|PARSE-Enclosure|
                               (CONS '|brace|
                                     (CONS
                                      (CONS '|construct|
-                                      (CONS (POP-STACK-1) NIL))
+                                      (CONS (|popStack1|) NIL))
                                      NIL))))
                      (AND (MATCH-ADVANCE-STRING "}")
-                          (PUSH-REDUCTION '|PARSE-Enclosure|
+                          (|pushReduction| '|PARSE-Enclosure|
                               (CONS '|brace| NIL))))))
       (AND (MATCH-ADVANCE-STRING "[|")
 	   (MUST (AND (|PARSE-Statement|)
 		      (MUST (MATCH-ADVANCE-STRING "|]"))
-		      (PUSH-REDUCTION '|PARSE-Enclosure|
+		      (|pushReduction| '|PARSE-Enclosure|
 				      (CONS '|[\|\|]|
-					    (CONS (POP-STACK-1) NIL)))
+					    (CONS (|popStack1|) NIL)))
 		      )))
       )) 
 
@@ -696,7 +696,7 @@
 
 (DEFUN |PARSE-FloatTok| ()
   (AND (PARSE-NUMBER)
-       (PUSH-REDUCTION '|PARSE-FloatTok| (POP-STACK-1)))) 
+       (|pushReduction| '|PARSE-FloatTok| (|popStack1|)))) 
 
 
 (DEFUN |PARSE-FormalParameter| () (|PARSE-FormalParameterTok|)) 
@@ -707,7 +707,7 @@
 
 (DEFUN |PARSE-Quad| ()
   (AND (MATCH-ADVANCE-STRING "$")
-       (PUSH-REDUCTION '|PARSE-Quad| '$)))
+       (|pushReduction| '|PARSE-Quad| '$)))
 
 
 (DEFUN |PARSE-String| () (PARSE-SPADSTRING)) 
@@ -717,10 +717,10 @@
   (AND (|PARSE-Name|)
        (OPTIONAL
            (AND (|PARSE-Scripts|)
-                (PUSH-REDUCTION '|PARSE-VarForm|
+                (|pushReduction| '|PARSE-VarForm|
                     (CONS '|Scripts|
-                          (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
-       (PUSH-REDUCTION '|PARSE-VarForm| (POP-STACK-1)))) 
+                          (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))
+       (|pushReduction| '|PARSE-VarForm| (|popStack1|)))) 
 
 
 (DEFUN |PARSE-Scripts| ()
@@ -734,23 +734,23 @@
                (AND (STAR REPEATOR
                           (AND (MATCH-ADVANCE-STRING ";")
                                (MUST (|PARSE-ScriptItem|))))
-                    (PUSH-REDUCTION '|PARSE-ScriptItem|
+                    (|pushReduction| '|PARSE-ScriptItem|
                         (CONS '|;|
-                              (CONS (POP-STACK-2)
-                                    (APPEND (POP-STACK-1) NIL)))))))
+                              (CONS (|popStack2|)
+                                    (APPEND (|popStack1|) NIL)))))))
       (AND (MATCH-ADVANCE-STRING ";") (MUST (|PARSE-ScriptItem|))
-           (PUSH-REDUCTION '|PARSE-ScriptItem|
-               (CONS '|PrefixSC| (CONS (POP-STACK-1) NIL)))))) 
+           (|pushReduction| '|PARSE-ScriptItem|
+               (CONS '|PrefixSC| (CONS (|popStack1|) NIL)))))) 
 
 
 (DEFUN |PARSE-Name| ()
-  (AND (PARSE-IDENTIFIER) (PUSH-REDUCTION '|PARSE-Name| (POP-STACK-1)))) 
+  (AND (PARSE-IDENTIFIER) (|pushReduction| '|PARSE-Name| (|popStack1|)))) 
 
 
 (DEFUN |PARSE-Data| ()
   (AND (ACTION (SETQ LABLASOC NIL)) (|PARSE-Sexpr|)
-       (PUSH-REDUCTION '|PARSE-Data|
-           (CONS 'QUOTE (CONS (TRANSLABEL (POP-STACK-1) LABLASOC) NIL))))) 
+       (|pushReduction| '|PARSE-Data|
+           (CONS 'QUOTE (CONS (TRANSLABEL (|popStack1|) LABLASOC) NIL))))) 
 
 
 (DEFUN |PARSE-Sexpr| ()
@@ -764,19 +764,19 @@
            (OPTIONAL
                (AND (|PARSE-NBGliphTok| '=) (MUST (|PARSE-Sexpr1|))
                     (ACTION (SETQ LABLASOC
-                                  (CONS (CONS (POP-STACK-2)
-                                         (NTH-STACK 1))
+                                  (CONS (CONS (|popStack2|)
+                                         (|nthStack| 1))
                                         LABLASOC))))))
       (AND (MATCH-ADVANCE-STRING "'") (MUST (|PARSE-Sexpr1|))
-           (PUSH-REDUCTION '|PARSE-Sexpr1|
-               (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))
+           (|pushReduction| '|PARSE-Sexpr1|
+               (CONS 'QUOTE (CONS (|popStack1|) NIL))))
       ;; next form disabled -- gdr, 2009-06-15.
 ;      (AND (MATCH-ADVANCE-STRING "-") (MUST (|PARSE-IntegerTok|))
-;           (PUSH-REDUCTION '|PARSE-Sexpr1| (MINUS (POP-STACK-1))))
+;           (|pushReduction| '|PARSE-Sexpr1| (MINUS (|popStack1|))))
       (AND (MATCH-ADVANCE-STRING "[")
            (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Sexpr1|))))
            (MUST (MATCH-ADVANCE-STRING "]"))
-           (PUSH-REDUCTION '|PARSE-Sexpr1| (LIST2VEC (POP-STACK-1))))
+           (|pushReduction| '|PARSE-Sexpr1| (LIST2VEC (|popStack1|))))
       (AND (MATCH-ADVANCE-STRING "(")
            (BANG FIL_TEST
                  (OPTIONAL
@@ -784,8 +784,8 @@
                           (OPTIONAL
                               (AND (|PARSE-GlyphTok| ".")
                                    (MUST (|PARSE-Sexpr1|))
-                                   (PUSH-REDUCTION '|PARSE-Sexpr1|
-                                    (|append!| (POP-STACK-2) (POP-STACK-1))))))))
+                                   (|pushReduction| '|PARSE-Sexpr1|
+                                    (|append!| (|popStack2|) (|popStack1|))))))))
            (MUST (MATCH-ADVANCE-STRING ")"))))) 
 
 
@@ -804,7 +804,7 @@
 (DEFUN |PARSE-AnyId| ()
   (OR (|PARSE-Name|)
       (OR (AND (MATCH-STRING "$")
-               (PUSH-REDUCTION '|PARSE-AnyId| (CURRENT-SYMBOL))
+               (|pushReduction| '|PARSE-AnyId| (CURRENT-SYMBOL))
                (ACTION (ADVANCE-TOKEN)))
           (PARSE-KEYWORD)
 	  (|PARSE-OperatorFunctionName|))))
@@ -815,32 +815,32 @@
            (MUST (MATCH-ADVANCE-STRING "]")))
       (AND (|PARSE-OpenBrace|) (MUST (|PARSE-Sequence1|))
            (MUST (MATCH-ADVANCE-STRING "}"))
-           (PUSH-REDUCTION '|PARSE-Sequence|
-               (CONS '|brace| (CONS (POP-STACK-1) NIL)))))) 
+           (|pushReduction| '|PARSE-Sequence|
+               (CONS '|brace| (CONS (|popStack1|) NIL)))))) 
 
 
 (DEFUN |PARSE-Sequence1| ()
   (AND (OR (AND (|PARSE-Expression|)
-                (PUSH-REDUCTION '|PARSE-Sequence1|
-                    (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))
-           (PUSH-REDUCTION '|PARSE-Sequence1| (CONS (POP-STACK-1) NIL)))
+                (|pushReduction| '|PARSE-Sequence1|
+                    (CONS (|popStack2|) (CONS (|popStack1|) NIL))))
+           (|pushReduction| '|PARSE-Sequence1| (CONS (|popStack1|) NIL)))
        (OPTIONAL
            (AND (|PARSE-IteratorTail|)
-                (PUSH-REDUCTION '|PARSE-Sequence1|
+                (|pushReduction| '|PARSE-Sequence1|
                     (CONS 'COLLECT
-                          (APPEND (POP-STACK-1)
-                                  (CONS (POP-STACK-1) NIL)))))))) 
+                          (APPEND (|popStack1|)
+                                  (CONS (|popStack1|) NIL)))))))) 
 
 
 (DEFUN |PARSE-OpenBracket| ()
   (LET ((G1 (CURRENT-SYMBOL)))
     (AND (EQ (|getToken| G1) '[)
 	 (MUST (OR (AND (EQCAR G1 '|elt|)
-			(PUSH-REDUCTION '|PARSE-OpenBracket|
+			(|pushReduction| '|PARSE-OpenBracket|
 			    (CONS '|elt|
 				  (CONS (CADR G1)
 				   (CONS '|construct| NIL)))))
-		   (PUSH-REDUCTION '|PARSE-OpenBracket| '|construct|)))
+		   (|pushReduction| '|PARSE-OpenBracket| '|construct|)))
 	 (ACTION (ADVANCE-TOKEN)))))
 
 
@@ -848,11 +848,11 @@
   (LET ((G1 (CURRENT-SYMBOL)))
     (AND (EQ (|getToken| G1) '{)
 	 (MUST (OR (AND (EQCAR G1 '|elt|)
-			(PUSH-REDUCTION '|PARSE-OpenBrace|
+			(|pushReduction| '|PARSE-OpenBrace|
 			    (CONS '|elt|
 				  (CONS (CADR G1)
 				   (CONS '|brace| NIL)))))
-		   (PUSH-REDUCTION '|PARSE-OpenBrace| '|construct|)))
+		   (|pushReduction| '|PARSE-OpenBrace| '|construct|)))
 	 (ACTION (ADVANCE-TOKEN)))))
 
 
diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot
index 506e22c6..d26ef72d 100644
--- a/src/interp/lexing.boot
+++ b/src/interp/lexing.boot
@@ -71,7 +71,7 @@ stackClear! st ==
   stackStore(st) := nil
   stackSize(st) := 0
   stackTop(st) := nil
-  stackUpdate?(st) := false
+  stackUpdated?(st) := false
 
 stackPush!(x,st) ==
   stackStore(st) := [x,:stackStore st]
@@ -86,3 +86,61 @@ stackPop! st ==
   if stackStore st ~= nil then
     stackTop(st) := first stackStore st
   y
+
+
+--%  
+--% Parsing reduction stack
+--%
+--% Abstractly;
+--%   structure Reduction == Record(rule: RuleName, value: ParseTree)
+--%
+makeReduction(p == nil,v == nil) ==
+  [p,v]
+
+macro reductionRule r ==
+  first r
+
+macro reductionValue r ==
+  second r
+
+++ stack of results of reduced productions
+$reduceStack := makeStack()
+
+pushReduction(rn,pt) ==
+  stackPush!(makeReduction(rn,pt),$reduceStack)
+
+popReduction() ==
+  stackPop! $reduceStack
+  
+reduceStackClear() ==
+  stackClear! $reduceStack
+
+popStack1() ==
+  reductionValue popReduction()
+
+popStack2() ==
+  r1 := popReduction()
+  r2 := popReduction()
+  stackPush!(r1,$reduceStack)
+  reductionValue r2
+
+popStack3() ==
+  r1 := popReduction()
+  r2 := popReduction()
+  r3 := popReduction()
+  stackPush!(r2,$reduceStack)
+  stackPush!(r1,$reduceStack)
+  reductionValue r3
+
+popStack4() ==
+  r1 := popReduction()
+  r2 := popReduction()
+  r3 := popReduction()
+  r4 := popReduction()
+  stackPush!(r3,$reduceStack)
+  stackPush!(r2,$reduceStack)
+  stackPush!(r1,$reduceStack)
+  reductionValue r4
+
+nthStack n ==
+  reductionValue stackStore($reduceStack).(n - 1)
diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp
index 4e9c208a..532ed9e6 100644
--- a/src/interp/metalex.lisp
+++ b/src/interp/metalex.lisp
@@ -57,7 +57,6 @@
 ;
 ;               A. Line Buffer
 ;               C. Token
-;               D. Reduction
 
 ; 1A. A Line Buffer
 ;
@@ -320,36 +319,8 @@ NonBlank is true if the token is not preceded by a blank."
        (decf Valid-Tokens))))
 
 
-; 1D. A Reduction
-;
-
-(defstruct (Reduction (:type list))
-"A reduction of a rule is any S-Expression the rule chooses to stack."
-  (Rule nil)            ; Name of rule
-  (Value nil))
-
-; 2. Recursive descent parsing support routines (semantically related to MetaLanguage)
-;
-; This section of the code contains:
-;
-;               A. Routines for stacking and retrieving reductions of rules.
-;               B. Routines for applying certain metagrammatical elements
-;                  of a production (e.g., Star).
-;               C. Token-level parsing utilities (keywords, strings, identifiers).
-
-; 2A. Routines for stacking and retrieving reductions of rules.
-
-; FUNCTIONS DEFINED IN THIS SECTION:
-;
-;       Push-Reduction Pop-Reduction
-
-(defparameter Reduce-Stack (|makeStack|) "Stack of results of reduced productions.")
-
-(defun Push-Reduction (rule redn)
-  (|stackPush!| (make-reduction :rule rule :value redn) Reduce-Stack))
-
 (defun reduce-stack-show ()
-  (let ((store (|stackStore| reduce-stack))
+  (let ((store (|stackStore| |$reduceStack|))
         (*print-pretty* t))
     (if store
         (progn (format t "~%Reduction stack contains:~%")
@@ -357,39 +328,9 @@ NonBlank is true if the token is not preceded by a blank."
 			   (if (eq (type-of x) 'token)
                                (describe x)
 			     (print x)))
-                       (|stackStore| reduce-stack)))
+                       (|stackStore| |$reduceStack|)))
         (format t "~%There is nothing on the reduction stack.~%"))))
 
-(defmacro reduce-stack-clear () `(|stackLoad!| nil reduce-stack))
-
-(defun Pop-Reduction () (|stackPop!| Reduce-Stack))
-
-(defmacro pop-stack-1 () '(reduction-value (Pop-Reduction)))
-
-(defmacro pop-stack-2 ()
-  `(let* ((top (Pop-Reduction)) (next (Pop-Reduction)))
-     (|stackPush!| top Reduce-Stack)
-     (reduction-value next)))
-
-(defmacro pop-stack-3 ()
-  `(let* ((top (Pop-Reduction)) (next (Pop-Reduction)) (nnext (Pop-Reduction)))
-     (|stackPush!| next Reduce-Stack)
-     (|stackPush!| top Reduce-Stack)
-     (reduction-value nnext)))
-
-(defmacro pop-stack-4 ()
-  `(let* ((top (Pop-Reduction))
-          (next (Pop-Reduction))
-          (nnext (Pop-Reduction))
-          (nnnext (Pop-Reduction)))
-     (|stackPush!| nnext Reduce-Stack)
-     (|stackPush!| next Reduce-Stack)
-     (|stackPush!| top Reduce-Stack)
-     (reduction-value nnnext)))
-
-(defmacro nth-stack (x)
-  `(reduction-value (nth (1- ,x) (|stackStore| Reduce-Stack))))
-
  
 ; *** 2. META Line Handling
 (defparameter Comment-Character #\% "Delimiter of comments in Meta code.")
@@ -441,7 +382,7 @@ NonBlank is true if the token is not preceded by a blank."
   `(defun ,(intern (concatenate 'string "PARSE-" (string token))) ()
      (let* ((tok (match-current-token ',token))
             (symbol (if tok (token-symbol tok))))
-       (if tok (progn (Push-Reduction
+       (if tok (progn (|pushReduction|
                         ',(intern (concatenate 'string (string token)
                                                "-TOKEN"))
                         (copy-tree symbol))
@@ -562,7 +503,7 @@ as keywords.")
 				(match-current-token 'gliph)
 				(match-current-token 'special-char)))))
     (when (and id (member id |$OperatorFunctionNames|))
-      (Push-Reduction '|PARSE-OperatorFunctionName| id)
+      (|pushReduction| '|PARSE-OperatorFunctionName| id)
       (action (advance-token)))))
 
 ; Meta tokens fall into the following categories:
diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp
index e2f1c2e9..ae0b83f4 100644
--- a/src/interp/parsing.lisp
+++ b/src/interp/parsing.lisp
@@ -109,22 +109,22 @@ the sub-reductions of PROD and labelling them with LAB.
 E.G., (Star IDs (parse-id)) with A B C will stack (3 IDs (A B C)),
 where (parse-id) would stack (1 ID (A)) when applied once."
 
-  `(prog ((oldstacksize (|stackSize| reduce-stack)))
+  `(prog ((oldstacksize (|stackSize| |$reduceStack|)))
          (if (not ,prod) ;(progn (format t "~&Star failed for ~A.~%" ',lab) (return nil)))
              (return nil))
     loop (if (not ,prod)
-             (let* ((newstacksize (|stackSize| reduce-stack))
+             (let* ((newstacksize (|stackSize| |$reduceStack|))
                     (number-of-new-reductions (- newstacksize oldstacksize)))
 ;              (format t "~&Starring ~A with ~D new reductions.~%"
 ;                      ',lab number-of-new-reductions)
                (if (> number-of-new-reductions 0)
                    (return (do ((i 0 (1+ i)) (accum nil))
                                ((= i number-of-new-reductions)
-                                (Push-Reduction ',lab accum)
+                                (|pushReduction| ',lab accum)
 ;                               (format t "~&Star accumulated ~D reductions.~%"
 ;                                       (length accum))
                                 (return t))
-                             (push (pop-stack-1) accum)))
+                             (push (|popStack1|) accum)))
                    (return t)))
              (go loop))))
 
@@ -133,18 +133,13 @@ where (parse-id) would stack (1 ID (A)) when applied once."
 "If the execution of prod does not result in an increase in the size of
 the stack, then stack a NIL. Return the value of prod."
 
-  `(progn (setf (|stackUpdated?| reduce-stack) nil)
-;         (format t "~&Banging ~A~:[~; and I think the stack is updated!~].~%" ',lab
-;                 (stack-updated reduce-stack))
+  `(progn (setf (|stackUpdated?| |$reduceStack|) nil)
           (let* ((prodvalue ,prod)
-                 (updated (|stackUpdated?| reduce-stack)))
-;           (format t "~&Bang thinks that ~A ~:[didn't do anything~;did something~].~&"
-;                   ',lab prodvalue)
+                 (updated (|stackUpdated?| |$reduceStack|)))
             (if updated
                 (progn ; (format t "~&Banged ~A and I think the stack is updated!~%" ',lab)
                        prodvalue)
-                (progn (push-reduction ',lab nil)
-                       ; (format t "~&Banged ~A.~%" ',lab)
+                (progn (|pushReduction| ',lab nil)
                        prodvalue)))))
 
 (defmacro must (dothis &optional (this-is nil) (in-rule nil))
@@ -233,7 +228,7 @@ the stack, then stack a NIL. Return the value of prod."
 
 (defun conversation (x y)
   (prog (u)
-     a  (reduce-stack-clear)
+     a  (|reduceStackClear|)
         (setq u (namederrset 'spad_reader (conversation1 x y) ))
         (cond (*eof* (return nil))
               ((atom u) (go a))
@@ -247,7 +242,7 @@ the stack, then stack a NIL. Return the value of prod."
               ((and (current-token) (next-token)) (go top))
               ((compfin) (return 't))
               ((and (funcall firstfun)
-                    (or (funcall procfun (pop-stack-1))))
+                    (or (funcall procfun (|popStack1|))))
                (go top))
               ((compfin) (return 't)) )
         (spad_syntax_error)
@@ -432,7 +427,7 @@ the stack, then stack a NIL. Return the value of prod."
      c1  (cond ( (not (identp tok)) (go d1)))
          (princ "/isid= ")
         ;; (princ (cond (isid "T") (t "NIL")))
-     d1  (princ "/stack= ")            (prin1 (|stackStore| reduce-stack))
+     d1  (princ "/stack= ")            (prin1 (|stackStore| |$reduceStack|))
          (setq v (apply fun* argl*))           (setq /depth (- /depth 1))
          (terpri)
          (trblanks (* 2 /depth))          (princ (stringimage (\1+ /depth)))
@@ -447,7 +442,7 @@ the stack, then stack a NIL. Return the value of prod."
      c2  (if (not (identp tok)) (go d2))
          (princ "/isid= ")
         ;; (princ (if isid "T" "NIL"))
-     d2  (princ "/stack= ")            (prin1 (|stackStore| reduce-stack))
+     d2  (princ "/stack= ")            (prin1 (|stackStore| |$reduceStack|))
          (princ "/value= ")         (prin1 v)
          (return v)))))))
 
@@ -502,11 +497,9 @@ the stack, then stack a NIL. Return the value of prod."
 
 (defun IOStat ()
   "Tell me what the current state of the parsing world is."
-  ;(IOStreams-show)
   (current-line-show)
   (if $SPAD (next-lines-show))
   (token-stack-show)
-  ;(reduce-stack-show)
   nil)
 
 (defun IOClear (&optional (in t) (out t))
@@ -514,7 +507,7 @@ the stack, then stack a NIL. Return the value of prod."
   (input-clear)
   (current-line-clear)
   (token-stack-clear)
-  (reduce-stack-clear)
+  (|reduceStackClear|)
   (if $SPAD (next-lines-clear))
   nil)
 
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index eab3bbec..719f7258 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -80,7 +80,7 @@ parseSpadFile sourceFile ==
     BOOT_-LINE_-STACK : local := PREPARSE IN_-STREAM
     LINE : local := CDAR BOOT_-LINE_-STACK
     CATCH('SPAD__READER,PARSE_-NewExpr())
-    asts := [parseTransform postTransform POP_-STACK_-1(), :asts]
+    asts := [parseTransform postTransform popStack1(), :asts]
   -- clean up the mess, and get out of here
   IOCLEAR(IN_-STREAM, OUT_-STREAM)             
   SHUT IN_-STREAM                              
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index 73ebd5f6..0a6800cb 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -268,7 +268,7 @@
   (ioclear)
   (LET* ((BOOT-LINE-STACK (LIST (CONS 1 LINE)))
      ($SPAD T)
-     (PARSEOUT (PROG2 (|PARSE-NewExpr|) (POP-STACK-1))))
+     (PARSEOUT (PROG2 (|PARSE-NewExpr|) (|popStack1|))))
     (DECLARE (SPECIAL BOOT-LINE-STACK $SPAD))
     PARSEOUT))