* lisp/core.lisp.in: Add ref and deref to support references.

	* interp/sys-constants.boot ($OperatorFunctionNames): Add "by" and
	"..".
	* interp/spad.lisp: Tidy.
	* interp/spad-parser.boot: New parsers.
	* interp/preparse.lisp: Remove dead codes.
	* interp/parsing.lisp (MATCH-ADVANCE-KEYWORD): Remove.
	* interp/parse.boot (doParseCategory): Rename from parseCategory.
	* interp/newaux.lisp: Tidy.
	* interp/lexing.boot (getSpadToken): New.
	(Keywords): Remove 'when'.
	(matchKeywordNext): New.
	(matchSpecial): Likewise.
	(matchAdvanceSpecial): Likewise.
	(matchAdvanceGlyph): Likewise.
	* interp/fnewmeta.lisp: Move variable definitions to preparse.lisp.
	Remove Lisp based parsers.
	Remove file.
	* interp/c-doc.boot (recordAttributeDocumentation): Fix thinko.
	* interp/bootlex.lisp (GET-BOOT-TOKEN): Remove.
	* interp/Makefile.in: Adjust dependencies.
	* boot/parser.boot (bpChar): New.
	(bpPattern): Allow character constants.

15 files changed, 692 insertions, 775 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 63ed42d9..2fc0070c 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,29 @@
+2011-10-17  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* lisp/core.lisp.in: Add ref and deref to support references.
+	* interp/sys-constants.boot ($OperatorFunctionNames): Add "by" and
+	"..".
+	* interp/spad.lisp: Tidy.
+	* interp/spad-parser.boot: New parsers.
+	* interp/preparse.lisp: Remove dead codes.
+	* interp/parsing.lisp (MATCH-ADVANCE-KEYWORD): Remove.
+	* interp/parse.boot (doParseCategory): Rename from parseCategory.
+	* interp/newaux.lisp: Tidy.
+	* interp/lexing.boot (getSpadToken): New.
+	(Keywords): Remove 'when'.
+	(matchKeywordNext): New.
+	(matchSpecial): Likewise.
+	(matchAdvanceSpecial): Likewise.
+	(matchAdvanceGlyph): Likewise.
+	* interp/fnewmeta.lisp: Move variable definitions to preparse.lisp.
+	Remove Lisp based parsers.
+	Remove file.
+	* interp/c-doc.boot (recordAttributeDocumentation): Fix thinko.
+	* interp/bootlex.lisp (GET-BOOT-TOKEN): Remove.
+	* interp/Makefile.in: Adjust dependencies.
+	* boot/parser.boot (bpChar): New.
+	(bpPattern): Allow character constants.
+
 2011-10-16  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* algebra/boolean.spad.pamphlet (Boolean): Implement default
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index f2c0a721..f9ae96dc 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -383,6 +383,16 @@ bpConstTok() ==
          bpPush bfSymbol bpPop1()
   bpString()
 
+bpChar() ==
+  $stok is ["ID",:.] and $ttok is "char" =>
+    a := bpState()
+    bpApplication() =>
+      s := bpPop1()
+      s is ["char",.] => bpPush s
+      bpRestore a
+      false
+    false
+  false
 
 ++ Subroutine of bpExportItem.  Parses tails of ExportItem.
 bpExportItemTail() ==
@@ -1004,7 +1014,7 @@ bpDConstruction()==
  
 bpPattern()==
   bpBracketConstruct function bpPatternL
-    or bpName() or bpConstTok()
+    or bpChar() or bpName() or bpConstTok()
  
 bpEqual()==
    bpEqKey "SHOEEQ" and (bpApplication() or bpConstTok() or
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 2093e74e..964d7914 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -100,7 +100,7 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	record.$(FASLEXT)	rulesets.$(FASLEXT)	\
 	server.$(FASLEXT)	setvars.$(FASLEXT)	\
 	sfsfun-l.$(FASLEXT)	sfsfun.$(FASLEXT)	\
-	slam.$(FASLEXT)		fnewmeta.$(FASLEXT)	\
+	slam.$(FASLEXT)		                        \
 	preparse.$(FASLEXT)	bootlex.$(FASLEXT)	\
 	spad.$(FASLEXT)		spaderror.$(FASLEXT)	\
 	                       	termrw.$(FASLEXT)	\
@@ -322,15 +322,14 @@ server.$(FASLEXT): macros.$(FASLEXT)
 
 ## The old parser component roughtly is:
 ##
-spad-parser.$(FASLEXT): parsing.$(FASLEXT) parse.$(FASLEXT) fnewmeta.$(FASLEXT)
+spad-parser.$(FASLEXT): parse.$(FASLEXT) preparse.$(FASLEXT)
 parse.$(FASLEXT): parsing.$(FASLEXT) postpar.$(FASLEXT)
 packtran.$(FASLEXT): sys-macros.$(FASLEXT)
 postpar.$(FASLEXT): macros.$(FASLEXT)
 bootlex.$(FASLEXT): preparse.$(FASLEXT) macros.$(FASLEXT) \
 			nlib.$(FASLEXT) sys-globals.$(FASLEXT)
 newaux.$(FASLEXT): macros.$(FASLEXT)
-preparse.$(FASLEXT): fnewmeta.$(FASLEXT)
-fnewmeta.$(FASLEXT): parsing.$(FASLEXT)
+preparse.$(FASLEXT): parsing.$(FASLEXT)
 parsing.$(FASLEXT): lexing.$(FASLEXT) macros.$(FASLEXT)
 nlib.$(FASLEXT): macros.$(FASLEXT)
 macros.$(FASLEXT): sys-macros.$(FASLEXT) sys-utility.$(FASLEXT)
diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp
index b90cb4ba..93d6b997 100644
--- a/src/interp/bootlex.lisp
+++ b/src/interp/bootlex.lisp
@@ -154,26 +154,6 @@
 
 ;  *** 3. BOOT Token Handling ***
 
-(defun get-BOOT-token (token)
-
-  "If you have an _, go to the next line.
-If you have a . followed by an integer, get a floating point number.
-Otherwise, get a .. identifier."
-
-  (if (not (|skipBlankChars|))
-      nil
-      (let ((token-type (|tokenLookaheadType| (|currentChar|))))
-        (case token-type
-          (eof                  (|tokenInstall| nil '*eof token |$nonblank|))
-          (escape               (|advanceChar!|)
-                                (|getIdentifier| token t))
-          (argument-designator  (get-argument-designator-token token))
-          (id                   (|getIdentifier| token nil))
-          (num                  (get-spad-integer-token token))
-          (string               (|getSpadString| token))
-          (special-char         (|getSpecial| token))
-          (t                    (|getGliph| token token-type))))))
-
 (defun get-argument-designator-token (token)
   (|advanceChar!|)
   (get-number-token token)
diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot
index fbf666f0..0b341a16 100644
--- a/src/interp/c-doc.boot
+++ b/src/interp/c-doc.boot
@@ -97,7 +97,7 @@ readForDoc fn ==
 recordSignatureDocumentation(opSig,lineno) ==
   recordDocumentation(rest postTransform opSig,lineno)
 
-recordAttributeDocumentation(['Attribute,att],lineno) ==
+recordAttributeDocumentation(['%Attribute,att],lineno) ==
   name := opOf att
   upperCase? stringChar(symbolName name,0) => nil
   recordDocumentation([name,['attribute,:IFCDR postTransform att]],lineno)
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
deleted file mode 100644
index f36d4f37..00000000
--- a/src/interp/fnewmeta.lisp
+++ /dev/null
@@ -1,627 +0,0 @@
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; All rights reserved.
-;; Copyright (C) 2007-2011, Gabriel Dos Reis.
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are
-;; met:
-;;
-;;     - Redistributions of source code must retain the above copyright
-;;       notice, this list of conditions and the following disclaimer.
-;;
-;;     - Redistributions in binary form must reproduce the above copyright
-;;       notice, this list of conditions and the following disclaimer in
-;;       the documentation and/or other materials provided with the
-;;       distribution.
-;;
-;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
-;;       names of its contributors may be used to endorse or promote products
-;;       derived from this software without specific prior written permission.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-;; % Binding powers stored under the Led and Red properties of an operator
-;; % are set up by the file BOTTOMUP.LISP.  The format for a Led property
-;; % is <Operator Left-Power Right-Power>, and the same for a Nud, except that
-;; % it may also have a fourth component <Special-Handler>. ELEMN attempts to
-;; % get the Nth indicator, counting from 1.
-
-(IMPORT-MODULE "parsing")
-(IN-PACKAGE "BOOT" )
-
-
-(DEFPARAMETER |tmptok| NIL)
-(DEFPARAMETER TOK NIL)
-(DEFPARAMETER |ParseMode| NIL)
-(DEFPARAMETER DEFINITION_NAME NIL)
-(DEFPARAMETER LABLASOC NIL)
-
-(defun |isTokenDelimiter| () 
-       (MEMBER (|currentSymbol|) '(\) END\_UNIT NIL)))
-
-(DEFUN |PARSE-SpecialCommand| ()
-  (OR (AND (|matchAdvanceString| "show")
-           (BANG FIL_TEST
-                 (OPTIONAL
-                     (OR (|matchAdvanceString| "?")
-                         (|PARSE-Expression|))))
-           (|pushReduction| '|PARSE-SpecialCommand|
-               (CONS '|show| (CONS (|popStack1|) NIL)))
-           (MUST (|PARSE-CommandTail|)))
-      (AND (MEMBER (|currentSymbol|) |$noParseCommands|)
-           (ACTION (FUNCALL (|currentSymbol|))))
-      (AND (MEMBER (|currentSymbol|) |$tokenCommands|)
-           (|PARSE-TokenList|) (MUST (|PARSE-TokenCommandTail|)))
-      (AND (STAR REPEATOR (|parsePrimaryOrQM|))
-           (MUST (|PARSE-CommandTail|))))) 
-
-
-(DEFUN |PARSE-TokenList| ()
-  (STAR REPEATOR
-        (AND (NOT (|isTokenDelimiter|))
-             (|pushReduction| '|PARSE-TokenList| (|currentSymbol|))
-             (ACTION (|advanceToken|))))) 
-
-
-(DEFUN |PARSE-TokenCommandTail| ()
-  (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|parseTokenOption|))))
-       (|atEndOfLine|)
-       (|pushReduction| '|PARSE-TokenCommandTail|
-           (CONS (|popStack2|) (APPEND (|popStack1|) NIL)))
-       (ACTION (|systemCommand| (|popStack1|))))) 
-
-(DEFUN |PARSE-CommandTail| ()
-  (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Option|))))
-       (|atEndOfLine|)
-       (|pushReduction| '|PARSE-CommandTail|
-           (CONS (|popStack2|) (APPEND (|popStack1|) NIL)))
-       (ACTION (|systemCommand| (|popStack1|))))) 
-
-(DEFUN |PARSE-Option| ()
-  (AND (|matchAdvanceString| ")")
-       (MUST (STAR REPEATOR (|parsePrimaryOrQM|))))) 
-
-
-(DEFUN |PARSE-Statement| ()
-  (AND (|PARSE-Expr| 0)
-       (OPTIONAL
-           (AND (STAR REPEATOR
-                      (AND (|matchAdvanceString| ",")
-                           (MUST (|PARSE-Expr| 0))))
-                (|pushReduction| '|PARSE-Statement|
-                    (CONS '|Series|
-                          (CONS (|popStack2|)
-                                (APPEND (|popStack1|) NIL)))))))) 
-
-(DEFUN |PARSE-Category| ()
-  (PROG (G1)
-    (RETURN
-      (OR (AND (MATCH-ADVANCE-KEYWORD "if") (MUST (|PARSE-Expression|))
-               (MUST (MATCH-ADVANCE-KEYWORD "then"))
-               (MUST (|PARSE-Category|))
-               (BANG FIL_TEST
-                     (OPTIONAL
-                         (AND (MATCH-ADVANCE-KEYWORD "else")
-                              (MUST (|PARSE-Category|)))))
-               (|pushReduction| '|PARSE-Category|
-                   (CONS '|if|
-                         (CONS (|popStack3|)
-                               (CONS (|popStack2|)
-                                     (CONS (|popStack1|) NIL))))))
-          (AND (|matchAdvanceString| "(") (MUST (|PARSE-Category|))
-               (BANG FIL_TEST
-                     (OPTIONAL
-                         (STAR REPEATOR
-                               (AND (|matchAdvanceString| ";")
-                                    (MUST (|PARSE-Category|))))))
-               (MUST (|matchAdvanceString| ")"))
-               (|pushReduction| '|PARSE-Category|
-                   (CONS 'CATEGORY
-                         (CONS (|popStack2|)
-                               (APPEND (|popStack1|) NIL)))))
-          (AND (ACTION (SETQ G1 (|lineNumber| |$spadLine|)))
-               (OR (|PARSE-Application|)
-		   (|parseOperatorFunctionName|))
-               (MUST (OR (AND (|matchAdvanceString| ":")
-                              (MUST (|PARSE-Expression|))
-                              (|pushReduction| '|PARSE-Category|
-                                  (CONS '|%Signature|
-                                        (CONS (|popStack2|)
-                                         (CONS (|popStack1|) NIL))))
-                              (ACTION (|recordSignatureDocumentation|
-                                       (|nthStack| 1) G1)))
-                         (AND (|pushReduction| '|PARSE-Category|
-                                  (CONS '|%Attribute|
-                                        (CONS (|popStack1|) NIL)))
-                              (ACTION (|recordAttributeDocumentation|
-                                       (|nthStack| 1) G1)))))))))) 
-
-
-(DEFUN |PARSE-Expression| ()
-  (AND (|PARSE-Expr|
-           (|PARSE-rightBindingPowerOf| (|makeSymbolOf| |$priorToken|)
-               |ParseMode|))
-       (|pushReduction| '|PARSE-Expression| (|popStack1|)))) 
-
-
-(DEFUN |PARSE-Import| ()
-  (AND (MATCH-ADVANCE-KEYWORD "import") 
-       (MUST (|PARSE-Expr| 1000))
-       (OR (AND (|matchAdvanceString| ":")
-                (MUST (|PARSE-Expression|))
-                (MUST (MATCH-ADVANCE-KEYWORD "from"))
-                (MUST (|PARSE-Expr| 1000))
-                (|pushReduction| '|PARSE-Import|
-		    (CONS '|%SignatureImport|
-			  (CONS (|popStack3|)
-				(CONS (|popStack2|)
-				      (CONS (|popStack1|) NIL))))))
-           (AND (BANG FIL_TEST
-		      (OPTIONAL
-		       (STAR REPEATOR
-			     (AND (|matchAdvanceString| ",")
-				  (MUST (|PARSE-Expr| 1000))))))
-		(|pushReduction| '|PARSE-Import|
-                    (CONS '|import|
-			  (CONS (|popStack2|) (APPEND (|popStack1|) NIL))))))))
-
-;; quantified types.  At the moment, these are used only in
-;; pattern-mathing cases.
-;; -- gdr, 2009-06-14.
-(DEFUN |PARSE-Scheme| ()
-  (OR (AND (|parseQuantifier|)
-	   (MUST (|PARSE-QuantifiedVariableList|))
-	   (MUST (|matchAdvanceString| "."))
-	   (MUST (|PARSE-Expr| 200))
-	   (MUST (|pushReduction| '|PARSE-Forall|
-				 (CONS (|popStack3|)
-				       (CONS (|popStack2|)
-					     (CONS (|popStack1|) NIL))))))
-      (|PARSE-Application|)))
-
-(DEFUN |PARSE-QuantifiedVariableList| ()
-  (AND (|matchAdvanceString| "(")
-       (MUST (|parseQuantifiedVariable|))
-       (OPTIONAL 
-	(AND (STAR REPEATOR 
-		   (AND (|matchAdvanceString| ",")
-			(MUST (|parseQuantifiedVariable|))))
-	     (|pushReduction| '|PARSE-QuantifiedVariableList|
-			     (CONS '|%Sequence|
-				   (CONS (|popStack2|) 
-					 (APPEND (|popStack1|) NIL))))))
-       (MUST (|matchAdvanceString| ")"))))
-
-(DEFUN |PARSE-SemiColon| ()
-  (AND (|matchAdvanceString| ";")
-       (MUST (OR (|PARSE-Expr| 82)
-                 (|pushReduction| '|PARSE-SemiColon| '|/throwAway|)))
-       (|pushReduction| '|PARSE-SemiColon|
-           (CONS '|;| (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) 
-
-(DEFUN |PARSE-Catch| ()
-  (AND (MATCH-SPECIAL ";")
-       (MATCH-KEYWORD-NEXT "catch")
-       (ACTION (|advanceToken|))
-       (ACTION (|advanceToken|))
-       (MUST (|PARSE-GlyphTok| "("))
-       (MUST (|parseQuantifiedVariable|))
-       (MUST (MATCH-ADVANCE-SPECIAL ")"))
-       (MUST (|PARSE-GlyphTok| "=>"))
-       (MUST (|PARSE-Expression|))
-       (|pushReduction| '|PARSE-Catch|
-	  (CONS (|popStack2|)
-		(CONS (|popStack1|) NIL)))))
-
-(DEFUN |PARSE-Finally| ()
-  (AND (MATCH-SPECIAL ";")
-       (MATCH-KEYWORD-NEXT "finally")
-       (ACTION (|advanceToken|))
-       (ACTION (|advanceToken|))
-       (MUST (|PARSE-Expression|))))
-
-(DEFUN |PARSE-Try| ()
-  (AND (MATCH-ADVANCE-KEYWORD "try")
-       (MUST (|PARSE-Expression|))
-       ;; exception handlers: either a finally-expression, or
-       ;; a series of catch-expressions optionally followed by
-       ;; a finally-expression.
-       (MUST (OR (AND (|PARSE-Finally|)
-		      (|pushReduction| '|PARSE-Try|
-                         (CONS '|%Try| 
-			       (CONS (|popStack2|)
-				     (CONS NIL
-					   (CONS (|popStack1|) NIL))))))
-		 (AND (MUST (STAR REPEATOR (|PARSE-Catch|)))
-		      (BANG FIL_TEST
-			    (OPTIONAL (|PARSE-Finally|)))
-		      (|pushReduction| '|PARSE-Try|
-                         (CONS '|%Try|
-			       (CONS (|popStack3|)
-				     (CONS (|popStack2|)
-					   (CONS (|popStack1|) 
-						 NIL))))))))))
-
-(DEFUN |PARSE-Seg| ()
-  (AND (|PARSE-GlyphTok| "..")
-       (BANG FIL_TEST (OPTIONAL (|PARSE-Expression|)))
-       (|pushReduction| '|PARSE-Seg|
-           (CONS 'SEGMENT
-                 (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) 
-
-
-(DEFUN |PARSE-Conditional| ()
-  (AND (MATCH-ADVANCE-KEYWORD "if") (MUST (|PARSE-Expression|))
-       (MUST (MATCH-ADVANCE-KEYWORD "then")) (MUST (|PARSE-Expression|))
-       (BANG FIL_TEST
-             (OPTIONAL
-                 (AND (MATCH-ADVANCE-KEYWORD "else")
-                      (MUST (|parseElseClause|)))))
-       (|pushReduction| '|PARSE-Conditional|
-           (CONS '|if|
-                 (CONS (|popStack3|)
-                       (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) 
-
-(DEFUN |PARSE-Loop| ()
-  (OR (AND (STAR REPEATOR (|PARSE-Iterator|))
-           (MUST (MATCH-ADVANCE-KEYWORD "repeat"))
-           (MUST (|PARSE-Expr| 110))
-           (|pushReduction| '|PARSE-Loop|
-               (CONS 'REPEAT
-                     (APPEND (|popStack2|) (CONS (|popStack1|) NIL)))))
-      (AND (MATCH-ADVANCE-KEYWORD "repeat") (MUST (|PARSE-Expr| 110))
-           (|pushReduction| '|PARSE-Loop|
-               (CONS 'REPEAT (CONS (|popStack1|) NIL)))))) 
-
-
-(DEFUN |PARSE-Variable| ()
-  (OR (AND (|parseName|)
-	   (OPTIONAL (AND (|matchAdvanceString| ":")
-			  (MUST (|PARSE-Application|))
-			  (MUST (|pushReduction| '|PARSE-Variable|
-				   (CONS '|:| 
-				      (CONS (|popStack2|)
-					    (CONS (|popStack1|) NIL))))))))
-      (|parsePrimary|)))
-
-(DEFUN |PARSE-Iterator| ()
-  (OR (AND (MATCH-ADVANCE-KEYWORD "for") (MUST (|PARSE-Variable|))
-           (MUST (MATCH-ADVANCE-KEYWORD "in"))
-           (MUST (|PARSE-Expression|))
-           (MUST (OR (AND (MATCH-ADVANCE-KEYWORD "by")
-                          (MUST (|PARSE-Expr| 200))
-                          (|pushReduction| '|PARSE-Iterator|
-                              (CONS 'INBY
-                                    (CONS (|popStack3|)
-                                     (CONS (|popStack2|)
-                                      (CONS (|popStack1|) NIL))))))
-                     (|pushReduction| '|PARSE-Iterator|
-                         (CONS 'IN
-                               (CONS (|popStack2|)
-                                     (CONS (|popStack1|) NIL))))))
-           (OPTIONAL
-               (AND (|matchAdvanceString| "|")
-                    (MUST (|PARSE-Expr| 111))
-                    (|pushReduction| '|PARSE-Iterator|
-                        (CONS '|\|| (CONS (|popStack1|) NIL))))))
-      (AND (MATCH-ADVANCE-KEYWORD "while") (MUST (|PARSE-Expr| 190))
-           (|pushReduction| '|PARSE-Iterator|
-               (CONS 'WHILE (CONS (|popStack1|) NIL))))
-      (AND (MATCH-ADVANCE-KEYWORD "until") (MUST (|PARSE-Expr| 190))
-           (|pushReduction| '|PARSE-Iterator|
-               (CONS 'UNTIL (CONS (|popStack1|) NIL)))))) 
-
-
-(DEFUN |PARSE-Match| ()
-  (AND (MATCH-ADVANCE-KEYWORD "case")
-       (MUST (|PARSE-Expr| 400))
-       (MATCH-ADVANCE-KEYWORD "is")
-       (MUST (|PARSE-Expr| 110))
-       (|pushReduction| '|PARSE-Match|
-		       (CONS '|%Match|
-			     (CONS (|popStack2|)
-				   (CONS (|popStack1|) NIL))))))
-
-(DEFUN |PARSE-Expr| (RBP)
-  (DECLARE (SPECIAL RBP))
-  (AND (|PARSE-NudPart| RBP)
-       (OPTIONAL (STAR OPT_EXPR (|PARSE-LedPart| RBP)))
-       (|pushReduction| '|PARSE-Expr| (|popStack1|)))) 
-
-(DEFUN |PARSE-LedPart| (RBP)
-  (DECLARE (SPECIAL RBP))
-  (AND (|PARSE-Operation| '|Led| RBP)
-       (|pushReduction| '|PARSE-LedPart| (|popStack1|)))) 
-
-
-(DEFUN |PARSE-NudPart| (RBP)
-  (DECLARE (SPECIAL RBP))
-  (AND (OR (|PARSE-Operation| '|Nud| RBP) (|PARSE-Reduction|)
-           (|PARSE-Form|))
-       (|pushReduction| '|PARSE-NudPart| (|popStack1|)))) 
-
-
-(DEFUN |PARSE-Operation| (|ParseMode| RBP)
-  (DECLARE (SPECIAL |ParseMode| RBP))
-  (AND (NOT (|matchCurrentToken| 'IDENTIFIER))
-       (GETL (SETQ |tmptok| (|currentSymbol|)) |ParseMode|)
-       (LT RBP (|PARSE-leftBindingPowerOf| |tmptok| |ParseMode|))
-       (ACTION (SETQ RBP
-                     (|PARSE-rightBindingPowerOf| |tmptok| |ParseMode|)))
-       (|PARSE-getSemanticForm| |tmptok| |ParseMode|
-           (ELEMN (GETL |tmptok| |ParseMode|) 5 NIL)))) 
-
-
-(DEFUN |PARSE-leftBindingPowerOf| (X IND)
-  (DECLARE (SPECIAL X IND))
-  (LET ((Y (GETL X IND))) (IF Y (ELEMN Y 3 0) 0))) 
-
-
-(DEFUN |PARSE-rightBindingPowerOf| (X IND)
-  (DECLARE (SPECIAL X IND))
-  (LET ((Y (GETL X IND))) (IF Y (ELEMN Y 4 105) 105))) 
-
-
-(DEFUN |PARSE-getSemanticForm| (X IND Y)
-  (DECLARE (SPECIAL X IND Y))
-  (OR (AND Y (EVAL Y)) (AND (EQ IND '|Nud|) (|parsePrefix|))
-      (AND (EQ IND '|Led|) (|parseInfix|)))) 
-
-
-(DEFUN |PARSE-Reduction| ()
-  (AND (|PARSE-ReductionOp|) (MUST (|PARSE-Expr| 1000))
-       (|pushReduction| '|PARSE-Reduction|
-           (CONS '|%Reduce|
-                 (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) 
-
-
-(DEFUN |PARSE-ReductionOp| ()
-  (AND (GETL (|currentSymbol|) '|Led|)
-       (|matchNextToken| 'GLIPH '/)
-       (|pushReduction| '|PARSE-ReductionOp| (|currentSymbol|))
-       (ACTION (|advanceToken|)) (ACTION (|advanceToken|)))) 
-
-
-(DEFUN |PARSE-Form| ()
-  (OR (AND (MATCH-ADVANCE-KEYWORD "iterate")
-           (|pushReduction| '|PARSE-Form| (CONS '|iterate| NIL)))
-      (AND (MATCH-ADVANCE-KEYWORD "yield") (MUST (|PARSE-Application|))
-           (|pushReduction| '|PARSE-Form|
-               (CONS '|yield| (CONS (|popStack1|) NIL))))
-      (|PARSE-Application|))) 
-
-
-(DEFUN |PARSE-Application| ()
-  (AND (|parsePrimary|) (OPTIONAL (STAR OPT_EXPR (|PARSE-Selector|)))
-       (OPTIONAL
-           (AND (|PARSE-Application|)
-                (|pushReduction| '|PARSE-Application|
-                    (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) 
-
-
-(DEFUN |PARSE-Selector| ()
-  (OR (AND |$nonblank| (EQ (|currentSymbol|) '|.|)
-           (CHAR-NE (|currentChar|) '| |) (|matchAdvanceString| ".")
-           (MUST (|PARSE-PrimaryNoFloat|))
-           (MUST (|pushReduction| '|PARSE-Selector|
-                     (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))
-      (AND (OR (|PARSE-Float|)
-               (AND (|matchAdvanceString| ".")
-                    (MUST (|parsePrimary|))))
-           (MUST (|pushReduction| '|PARSE-Selector|
-                     (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) 
-
-
-(DEFUN |PARSE-PrimaryNoFloat| ()
-  (AND (|PARSE-Primary1|) (OPTIONAL (|parseTokenTail|)))) 
-
-(DEFUN |PARSE-Primary1| ()
-  (OR (AND (|parseName|)
-           (OPTIONAL
-               (AND |$nonblank| (EQ (|currentSymbol|) '|(|)
-                    (MUST (|PARSE-Primary1|))
-                    (|pushReduction| '|PARSE-Primary1|
-                        (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))
-      (|parseQuad|) (|parseString|) (|parseInteger|)
-      (|parseFormalParameter|)
-      (AND (|matchAdvanceString| "'")
-           (MUST (AND (MUST (|PARSE-Data|))
-                      (|pushReduction| '|PARSE-Primary1| (|popStack1|)))))
-      (|PARSE-Sequence|) (|PARSE-Enclosure|))) 
-
-
-(DEFUN |PARSE-Float| ()
-  (AND (|PARSE-FloatBase|)
-       (MUST (OR (AND |$nonblank| (|PARSE-FloatExponent|))
-                 (|pushReduction| '|PARSE-Float| 0)))
-       (|pushReduction| '|PARSE-Float|
-           (MAKE-FLOAT (|popStack4|) (|popStack2|) (|popStack2|)
-               (|popStack1|))))) 
-
-
-(DEFUN |PARSE-FloatBase| ()
-  (OR (AND (INTEGERP (|currentSymbol|)) (CHAR-EQ (|currentChar|) ".")
-           (CHAR-NE (|nextChar|) ".") (|parseInteger|)
-           (MUST (|PARSE-FloatBasePart|)))
-      (AND (INTEGERP (|currentSymbol|))
-           (CHAR-EQ (CHAR-UPCASE (|currentChar|)) 'E)
-           (|parseInteger|) (|pushReduction| '|PARSE-FloatBase| 0)
-           (|pushReduction| '|PARSE-FloatBase| 0))
-      (AND (DIGITP (|currentChar|)) (EQ (|currentSymbol|) '|.|)
-           (|pushReduction| '|PARSE-FloatBase| 0)
-           (|PARSE-FloatBasePart|)))) 
-
-
-(DEFUN |PARSE-FloatBasePart| ()
-  (AND (|matchAdvanceString| ".")
-       (MUST (OR (AND (DIGITP (|currentChar|))
-                      (|pushReduction| '|PARSE-FloatBasePart|
-                          (|tokenNonblank?| (|currentToken|)))
-                      (|parseInteger|))
-                 (AND (|pushReduction| '|PARSE-FloatBasePart| 0)
-                      (|pushReduction| '|PARSE-FloatBasePart| 0)))))) 
-
-
-(DEFUN |PARSE-FloatExponent| ()
-  (PROG (G1)
-    (RETURN
-      (OR (AND (MEMBER (|currentSymbol|) '(E |e|))
-               (FIND (|currentChar|) "+-") (ACTION (|advanceToken|))
-               (MUST (OR (|parseInteger|)
-                         (AND (|matchAdvanceString| "+")
-                              (MUST (|parseInteger|)))
-                         (AND (|matchAdvanceString| "-")
-                              (MUST (|parseInteger|))
-                              (|pushReduction| '|PARSE-FloatExponent|
-                                  (MINUS (|popStack1|))))
-                         (|pushReduction| '|PARSE-FloatExponent| 0))))
-          (AND (IDENTP (|currentSymbol|))
-               (SETQ G1 (FLOATEXPID (|currentSymbol|)))
-               (ACTION (|advanceToken|))
-               (|pushReduction| '|PARSE-FloatExponent| G1)))))) 
-
-
-(DEFUN |PARSE-Enclosure| ()
-  (OR (AND (|matchAdvanceString| "(")
-           (MUST (OR (AND (|PARSE-Expr| 6)
-                          (MUST (|matchAdvanceString| ")")))
-                     (AND (|matchAdvanceString| ")")
-                          (|pushReduction| '|PARSE-Enclosure|
-                              (CONS '|%Comma| NIL))))))
-      (AND (|matchAdvanceString| "{")
-           (MUST (OR (AND (|PARSE-Expr| 6)
-                          (MUST (|matchAdvanceString| "}"))
-                          (|pushReduction| '|PARSE-Enclosure|
-                              (CONS '|brace|
-                                    (CONS
-                                     (CONS '|construct|
-                                      (CONS (|popStack1|) NIL))
-                                     NIL))))
-                     (AND (|matchAdvanceString| "}")
-                          (|pushReduction| '|PARSE-Enclosure|
-                              (CONS '|brace| NIL))))))
-      (AND (|matchAdvanceString| "[|")
-	   (MUST (AND (|PARSE-Statement|)
-		      (MUST (|matchAdvanceString| "|]"))
-		      (|pushReduction| '|PARSE-Enclosure|
-				      (CONS '|[\|\|]|
-					    (CONS (|popStack1|) NIL)))
-		      )))
-      )) 
-
-(DEFUN |PARSE-Data| ()
-  (AND (ACTION (SETQ LABLASOC NIL)) (|PARSE-Sexpr|)
-       (|pushReduction| '|PARSE-Data|
-           (CONS 'QUOTE (CONS (TRANSLABEL (|popStack1|) LABLASOC) NIL))))) 
-
-
-(DEFUN |PARSE-Sexpr| ()
-  (AND (ACTION (|advanceToken|)) (|PARSE-Sexpr1|))) 
-
-
-(DEFUN |PARSE-Sexpr1| ()
-  (OR (|parseInteger|)
-      (|parseString|)
-      (AND (|parseAnyId|)
-           (OPTIONAL
-               (AND (|PARSE-NBGliphTok| '=) (MUST (|PARSE-Sexpr1|))
-                    (ACTION (SETQ LABLASOC
-                                  (CONS (CONS (|popStack2|)
-                                         (|nthStack| 1))
-                                        LABLASOC))))))
-      (AND (|matchAdvanceString| "'") (MUST (|PARSE-Sexpr1|))
-           (|pushReduction| '|PARSE-Sexpr1|
-               (CONS 'QUOTE (CONS (|popStack1|) NIL))))
-      ;; next form disabled -- gdr, 2009-06-15.
-;      (AND (|matchAdvanceString| "-") (MUST (|parseInteger|))
-;           (|pushReduction| '|PARSE-Sexpr1| (MINUS (|popStack1|))))
-      (AND (|matchAdvanceString| "[")
-           (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Sexpr1|))))
-           (MUST (|matchAdvanceString| "]"))
-           (|pushReduction| '|PARSE-Sexpr1| (LIST2VEC (|popStack1|))))
-      (AND (|matchAdvanceString| "(")
-           (BANG FIL_TEST
-                 (OPTIONAL
-                     (AND (STAR REPEATOR (|PARSE-Sexpr1|))
-                          (OPTIONAL
-                              (AND (|PARSE-GlyphTok| ".")
-                                   (MUST (|PARSE-Sexpr1|))
-                                   (|pushReduction| '|PARSE-Sexpr1|
-                                    (|append!| (|popStack2|) (|popStack1|))))))))
-           (MUST (|matchAdvanceString| ")"))))) 
-
-
-(DEFUN |PARSE-NBGliphTok| (|tok|)
-  (DECLARE (SPECIAL |tok|))
-  (AND (|matchCurrentToken| 'GLIPH |tok|) |$nonblank|
-       (ACTION (|advanceToken|)))) 
-
-
-(DEFUN |PARSE-GlyphTok| (|tok|)
-  (DECLARE (SPECIAL |tok|))
-  (AND (|matchCurrentToken| 'GLIPH (INTERN |tok|))
-       (ACTION (|advanceToken|)))) 
-
-(DEFUN |PARSE-Sequence| ()
-  (OR (AND (|PARSE-OpenBracket|) (MUST (|PARSE-Sequence1|))
-           (MUST (|matchAdvanceString| "]")))
-      (AND (|PARSE-OpenBrace|) (MUST (|PARSE-Sequence1|))
-           (MUST (|matchAdvanceString| "}"))
-           (|pushReduction| '|PARSE-Sequence|
-               (CONS '|brace| (CONS (|popStack1|) NIL)))))) 
-
-
-(DEFUN |PARSE-Sequence1| ()
-  (AND (OR (AND (|PARSE-Expression|)
-                (|pushReduction| '|PARSE-Sequence1|
-                    (CONS (|popStack2|) (CONS (|popStack1|) NIL))))
-           (|pushReduction| '|PARSE-Sequence1| (CONS (|popStack1|) NIL)))
-       (OPTIONAL
-           (AND (|PARSE-IteratorTail|)
-                (|pushReduction| '|PARSE-Sequence1|
-                    (CONS 'COLLECT
-                          (APPEND (|popStack1|)
-                                  (CONS (|popStack1|) NIL)))))))) 
-
-
-(DEFUN |PARSE-OpenBracket| ()
-  (LET ((G1 (|currentSymbol|)))
-    (AND (EQ (|getToken| G1) '[)
-	 (MUST (OR (AND (EQCAR G1 '|elt|)
-			(|pushReduction| '|PARSE-OpenBracket|
-			    (CONS '|elt|
-				  (CONS (CADR G1)
-				   (CONS '|construct| NIL)))))
-		   (|pushReduction| '|PARSE-OpenBracket| '|construct|)))
-	 (ACTION (|advanceToken|)))))
-
-
-(DEFUN |PARSE-OpenBrace| ()
-  (LET ((G1 (|currentSymbol|)))
-    (AND (EQ (|getToken| G1) '{)
-	 (MUST (OR (AND (EQCAR G1 '|elt|)
-			(|pushReduction| '|PARSE-OpenBrace|
-			    (CONS '|elt|
-				  (CONS (CADR G1)
-				   (CONS '|brace| NIL)))))
-		   (|pushReduction| '|PARSE-OpenBrace| '|construct|)))
-	 (ACTION (|advanceToken|)))))
-
-
-(DEFUN |PARSE-IteratorTail| ()
-  (OR (AND (MATCH-ADVANCE-KEYWORD "repeat")
-           (BANG FIL_TEST
-                 (OPTIONAL (STAR REPEATOR (|PARSE-Iterator|)))))
-      (STAR REPEATOR (|PARSE-Iterator|)))) 
-
diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot
index d0f1c065..325aa513 100644
--- a/src/interp/lexing.boot
+++ b/src/interp/lexing.boot
@@ -188,8 +188,22 @@ tokenInstall(sym,typ,tok,nonblank == true) ==
   tokenNonblank?(tok) := nonblank
   tok
 
+getSpadToken tok ==
+  not skipBlankChars() => nil
+  tt := tokenLookaheadType currentChar()
+  tt is 'EOF => tokenInstall(nil,'_*EOF,tok,$nonblank)
+  tt is 'ESCAPE =>
+    advanceChar!()
+    getIdentifier(tok,true)
+  tt is 'ARGUMENT_-DESIGNATOR => GET_-ARGUMENT_-DESIGNATOR_-TOKEN tok
+  tt is 'ID => getIdentifier(tok,false)
+  tt is 'NUM => GET_-SPAD_-INTEGER_-TOKEN tok
+  tt is 'STRING => getSpadString tok
+  tt is 'SPECIAL_-CHAR => getSpecial tok
+  getGliph(tok,tt)
+
 tryGetToken tok ==
-  GET_-BOOT_-TOKEN tok =>
+  getSpadToken tok =>
    $validTokens := $validTokens + 1
    tok
   nil
@@ -205,9 +219,10 @@ nextToken() ==
   $validTokens > 1 => $nextToken
   tryGetToken $nextToken
 
-matchToken(tok,typ,sym == false) ==
+matchToken(tok,typ,sym == nil) ==
   tok ~= nil and symbolEq?(tokenType tok,typ) and
-    (sym = nil or symbolEq?(sym,tokenSymbol tok)) and tok
+    (sym = nil or sym = tokenSymbol tok) => tok
+  nil
 
 ++ Return the current token if it has type `typ', and possibly the
 ++ same spelling as `sym'.
@@ -299,10 +314,10 @@ getGliph(tok,gliphs) ==
       gliphs := rest gliphs
       advanceChar!()
     s := makeSymbol listToString reverse! buf
-    return tokenInstall(property(s,'RENAMETOK) or s,'GLIPH,tok,$nonblank)
+    return tokenInstall(s,'GLIPH,tok,$nonblank)
 
 Keywords == [
- "or", "and", "isnt", "is", "when", "where", "forall", "exist", "try",
+ "or", "and", "isnt", "is", "where", "forall", "exist", "try",
   "has", "with", "add", "case", "in", "by", "pretend", "mod", "finally",
    "exquo", "div", "quo", "else", "rem", "then", "suchthat", "catch", "throw",
     "if", "iterate", "break", "from", "exit", "leave", "return",
@@ -409,6 +424,24 @@ matchAdvanceKeyword kwd ==
     true
   false
 
+matchKeywordNext kwd ==
+  matchToken(nextToken(),'KEYWORD,kwd)
+
+matchSpecial c ==
+  matchToken(currentToken(),'SPECIAL_-CHAR,c)
+
+matchAdvanceSpecial c ==
+  matchSpecial c =>
+    advanceToken()
+    true
+  false
+
+matchAdvanceGlyph s ==
+  matchToken(currentToken(),'GLIPH,s) =>
+    advanceToken()
+    true
+  false
+
 --%
 --% Stack abstract datatype.
 --%  Operational semantics:
diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp
index 555c489c..3d668367 100644
--- a/src/interp/newaux.lisp
+++ b/src/interp/newaux.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2009, Gabriel Dos Reis.
+;; Copyright (C) 2007-2011, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -40,7 +40,6 @@
 ;
 ;               1. Led and Nud Tables
 ;               2. GLIPH  Table
-;               3. RENAMETOK Table
 ;               4. GENERIC Table
 ;               5. Character syntax class predicates
 
@@ -106,7 +105,7 @@
           (\@ 996 997)    (|pretend| 995 996)
           (\.)            (\! \! 1002 1001)
           (\, 110 111)
-          (\; 81 82 (|PARSE-SemiColon|))
+          (\; 81 82 (|parseSemicolon|))
           (< 400 400)    (> 400 400)
           (<< 400 400)  (>> 400 400)
           (<= 400 400)   (>= 400 400)
@@ -122,7 +121,7 @@
           (|is| 400 400)    (|isnt| 400 400)
           (|and| 250 251)   (|or| 200 201)
           (/\\ 250 251)   (\\/ 200 201)
-          (\.\. SEGMENT 401 699 (|PARSE-Seg|))
+          (\.\. SEGMENT 401 699 (|parseSegmentTail|))
           (=> 123 103)
           (+-> 998 121)
           (== DEF 122 121)
@@ -131,14 +130,14 @@
           (\:- LETD 125 124) (\:= %LET 125 124)))
  
 (mapcar #'(LAMBDA (J) (MAKENEWOP J `|Nud|))
-        '((|for| 130 350 (|PARSE-Loop|))
-          (|while| 130 190 (|PARSE-Loop|))
-          (|until| 130 190 (|PARSE-Loop|))
-          (|repeat| 130 190 (|PARSE-Loop|))
-          (|import| 120 0 (|PARSE-Import|) )
+        '((|for| 130 350 (|parseLoop|))
+          (|while| 130 190 (|parseLoop|))
+          (|until| 130 190 (|parseLoop|))
+          (|repeat| 130 190 (|parseLoop|))
+          (|import| 120 0 (|parseImport|) )
           (|inline| 120 0 (|parseInline|) )
-	  (|forall| 998 999 (|PARSE-Scheme|))
-	  (|exist| 998 999 (|PARSE-Scheme|))
+	  (|forall| 998 999 (|parseScheme|))
+	  (|exist| 998 999 (|parseScheme|))
           (|unless|)
           (|add| 900 120)
           (|with| 1000 300 (|parseWith|))
@@ -147,14 +146,14 @@
 ;;        (\+ 701 700)
           (\# 999 998)
           (\! 1002 1001)
-          (\' 999 999 (|PARSE-Data|))
+          (\' 999 999 (|parseData|))
           (-> 1001 1002)
           (\: 194 195)
           (|not| 260 259 NIL)
           (~ 260 259 nil)
           (= 400 700)
           (|return| 202 201 (|parseReturn|))
-          (|try| 202 201 (|PARSE-Try|))
+          (|try| 202 201 (|parseTry|))
 	  (|throw| 202 201 (|parseThrow|))
           (|leave| 202 201 (|parseLeave|))
           (|exit| 202 201 (|parseExit|))
@@ -162,45 +161,13 @@
 	  (|iterate| 202 201 (|parseJump|))
           (|from|)
           (|yield|)
-          (|if| 130 0 (|PARSE-Conditional|))    ; was 130
-          (|case| 130 190 (|PARSE-Match|))
+          (|if| 130 0 (|parseConditional|))    ; was 130
+          (|case| 130 190 (|parseMatch|))
           (\| 0 190)
           (|suchthat|)
           (|then| 0 114)
           (|else| 0 114)))
 
-
-;; Gliphs are symbol clumps. The gliph property of a symbol gives
-;; the tree describing the tokens which begin with that symbol.
-;; The token reader uses the gliph property to determine the longest token.
-;; Thus `:=' is read as one token not as `:' followed by `='.
-
-(mapcar #'(lambda (x) (makeprop (car x) 'gliph (cdr x)))
-        `(
-          ( \| (\))  (])   )
-          ( *  (*)         )
-          ( \( (\|)        )
-          ( +  (- (>))     )
-          ( -  (>)         )
-          ( <  (=) (<)     )
-	  ( /  (\\)        )
-          ( \\ (/)         )
-          ( >  (=) (>)     )
-          ( =  (= (>)) (>) )
-          ( \. (\.)        )
-          ( ^  (=)         )
-          ( \~ (=)         )
-          ( [  (\|)        )
-          ( \: (=) (-) (\:))))
-
-;; GENERIC operators be suffixed by `$' qualifications in SPAD code.  
-;; `$' is then followed by a domain label, such as I for Integer, which 
-;; signifies which domain the operator refers to.  For example `+$Integer' 
-;; is `+' for Integers.
- 
-(mapcar #'(lambda (x) (MAKEPROP X 'GENERIC 'TRUE))
-        '(- = * |rem| |mod| |quo| |div| / ** |exquo| + - < > <= >= ~= ))
-
 (defun SPECIALCASESYNTAX () (OR (AND (char= TOK '#\#) (DIGITP CHR))))
  
 (defun TERMINATOR (CHR)
diff --git a/src/interp/parse.boot b/src/interp/parse.boot
index 1af246df..9f30064d 100644
--- a/src/interp/parse.boot
+++ b/src/interp/parse.boot
@@ -237,9 +237,9 @@ parseTranCheckForRecord(x,op) ==
     x
   x
  
-parseCategory: %ParseForm -> %Form
-parseCategory t ==
-  t isnt ["CATEGORY",:x] => systemErrorHere ["parseCategory",t]
+doParseCategory: %ParseForm -> %Form
+doParseCategory t ==
+  t isnt ["CATEGORY",:x] => systemErrorHere ["doParseCategory",t]
   $parsingType: local := true
   l := parseTranList x
   key :=
@@ -445,7 +445,7 @@ for x in [[":", :"parseColon"],_
 	  ["::", :"parseCoerce"],_
 	  ["@", :"parseAtSign"],_
 	  ["and", :"parseAnd"],_
-	  ["CATEGORY", :"parseCategory"],_
+	  ["CATEGORY", :"doParseCategory"],_
 	  ["construct", :"parseConstruct"],_
 	  ["DEF", :"parseDEF"],_
 	  ["exit", :"doParseExit"],_
diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp
index 668bf1e3..ce5a2826 100644
--- a/src/interp/parsing.lisp
+++ b/src/interp/parsing.lisp
@@ -295,10 +295,6 @@ the stack, then stack a NIL. Return the value of prod."
 ;       (3) Line handling:      Next Line, Print Next Line
 ;       (X) Random Stuff
 
-(defun match-advance-keyword (str)
-  (and (|matchToken| (|currentToken|) 'keyword (intern str))
-       (action (|advanceToken|))))
-
 (defun match-advance-special (str)
   (and (|matchToken| (|currentToken|) 'special-char (character str))
        (action (|advanceToken|))))
diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp
index 47acccb4..aff89033 100644
--- a/src/interp/preparse.lisp
+++ b/src/interp/preparse.lisp
@@ -57,7 +57,7 @@
  
 
 
-(IMPORT-MODULE "fnewmeta")
+(IMPORT-MODULE "parsing")
  
 (in-package "BOOT")
  
@@ -70,29 +70,14 @@
 (defparameter $EchoLineStack nil                "Stack of lines to list.")
 (defparameter $IOIndex 0                        "Number of latest terminal input line.")
  
+(DEFPARAMETER TOK NIL)
+(DEFPARAMETER DEFINITION_NAME NIL)
+(DEFPARAMETER LABLASOC NIL)
+
 (defun Initialize-Preparse (strm)
   (setq $INDEX 0 $LineList nil $EchoLineStack nil)
   (setq $preparse-last-line (get-a-line strm)))
  
-(defmacro pptest () `(/rp ">scratchpad>test.boot"))
- 
-(defun /RP (&optional (*boot-input-file* nil) (*boot-output-file* nil)
-                      ($preparseReportIfTrue t))
-  (with-open-stream
-    (in-stream (or (and *boot-input-file* 
-			(open *boot-input-file* :direction :input))
-                   |$InputStream|))
-    (declare (special in-stream))
-    (with-open-stream
-      (out-stream (if *boot-output-file*
-                      (open *boot-output-file* :direction :output)
-                      |$OutputStream|))
-      (declare (special out-stream))
-      (initialize-preparse in-stream)
-      (do ((lines (PREPARSE in-stream) (PREPARSE in-stream))) ((null lines)))))
-  T)
-
-
 (defvar $skipme)
  
 (defun PREPARSE (Strm &aux (stack ()))
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index a7780674..43e04256 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -42,15 +42,26 @@
 -- -- gdr/2007-11-02
 --
 
-import parsing
+import preparse
 import parse
-import fnewmeta
 namespace BOOT
 
 --%
 macro compulsorySyntax s ==
   s or SPAD__SYNTAX__ERROR()
 
+repeatedSyntax(l,p) ==
+  n := stackSize $reduceStack
+  once := false
+  while apply(p,nil) repeat
+    once := true
+  not once => nil
+  x := nil
+  for i in (n+1)..stackSize $reduceStack repeat
+    x := [popStack1(),:x]
+  x = nil => true
+  pushReduction(l,x)
+
 --%
 
 parseToken tt ==
@@ -60,14 +71,77 @@ parseToken tt ==
     true
   false
 
+parseGlyph s ==
+  matchCurrentToken('GLIPH,s) =>
+    advanceToken()
+    true
+  false
+
+parseNBGlyph tok ==
+  matchCurrentToken('GLIPH,tok) and $nonblank =>
+    advanceToken()
+    true
+  false
+
 parseString() ==
   parseToken 'SPADSTRING
 
 parseInteger() ==
   parseToken 'NUMBER
 
+parseFloatBasePart() ==
+  matchAdvanceGlyph "." =>
+    $nonblank and (t := matchCurrentToken 'NUMBER) =>
+      t := copyToken t
+      advanceToken()
+      pushReduction('parseFloatBasePart,tokenNonblank? t)
+      pushReduction('parseFloatBasePart,tokenSymbol t)
+    pushReduction('parseFloatBasePart,0)
+    pushReduction('parseFloatBasePart,0)
+  nil
+
+parseFloatBase() ==
+  integer? currentSymbol() and currentChar() = char "." and
+    nextChar() ~= char "." and parseInteger() =>
+      compulsorySyntax parseFloatBasePart()
+  integer? currentSymbol() and charUpcase currentChar() = char "E"
+    and parseInteger() =>
+      pushReduction('parseBase,0)
+      pushReduction('parseBase,0)
+  digit? currentChar() and currentSymbol() is "." =>
+    pushReduction('parseBase,0)
+    pushReduction('parseBase,0)
+  nil
+
+parseFloatExponent() ==
+  not ident? currentSymbol() => nil
+  symbolMember?(currentSymbol(),'(e E)) and
+    charMember?(currentChar(),[char "+",char "-"]) =>
+      advanceToken()
+      parseInteger() => true
+      matchAdvanceGlyph "+" => compulsorySyntax parseInteger()
+      matchAdvanceGlyph "-" =>
+        compulsorySyntax parseInteger()
+        pushReduction('parseFloatExponent,-popStack1())
+      pushReduction('parseFloatExponent,0)
+  g := FLOATEXPID currentSymbol() =>
+    advanceToken()
+    pushReduction('parseFloatExponent,g)
+  nil
+
+parseFloat() ==
+  parseFloatBase() =>
+    $nonblank and parseFloatExponent()
+      or pushReduction('parseFloat,0)
+    pushReduction('parseFloat,
+      MAKE_-FLOAT(popStack4(),popStack2(),popStack2(),popStack1()))
+  nil
+
 parseName() ==
   parseToken 'IDENTIFIER and pushReduction('parseName,popStack1())
+
+parseKeyword() ==
+  parseToken 'KEYWORD and pushReduction('parseKeyword,popStack1())
   
 parseFormalParameter() ==
   parseToken 'ARGUMENT_-DESIGNATOR
@@ -84,6 +158,7 @@ parseOperatorFunctionName() ==
 
 parseAnyId() ==
   parseName() => true
+  parseKeyword() => true
   matchString '"$" =>
     pushReduction('parseAnyId,currentSymbol())
     advanceToken()
@@ -93,8 +168,26 @@ parseAnyId() ==
 parseQuad() ==
   matchAdvanceString '"$" and pushReduction('parseQuad,"$")
 
+parsePrimary1() ==
+  parseName() =>
+    $nonblank and currentSymbol() is "(" =>
+      compulsorySyntax parsePrimary1()
+      pushReduction('parsePrimary1,[popStack2(),popStack1()])
+    true
+  parseQuad() or parseString() or parseInteger() or
+    parseFormalParameter() => true
+  matchSpecial char "'" =>
+    compulsorySyntax parseData()
+    pushReduction('parsePrimary1,popStack1())
+  parseSequence() or parseEnclosure()
+
+parsePrimaryNoFloat() ==
+  parsePrimary1() =>
+    parseTokenTail() or true
+  false
+
 parsePrimary() ==
-  PARSE_-Float() or PARSE_-PrimaryNoFloat()
+  parseFloat() or parsePrimaryNoFloat()
 
 parsePrimaryOrQM() ==
   matchAdvanceString '"?" => pushReduction('parsePrimaryOrQM,"?")
@@ -105,8 +198,46 @@ parseSpecialKeyWord() ==
     tokenSymbol(currentToken()) := unAbbreviateKeyword currentSymbol()
   nil
 
+parseSexpr1() ==
+  parseInteger() or parseString() => true
+  parseAnyId() =>
+    parseNBGlyph "=" =>
+      compulsorySyntax parseSexpr1()
+      SETQ(LABLASOC,[[popStack2(),:nthStack 1],:LABLASOC])
+      true
+    true
+  matchAdvanceSpecial char "'" =>
+    compulsorySyntax parseSexpr1()
+    pushReduction('parseSexpr1,["QUOTE",popStack1()])
+  matchAdvanceGlyph "[" =>
+    stackUpdated?($reduceStack) := false
+    repeatedSyntax('parseSexpr1,function PARSE_-Sexpr1)
+    if not stackUpdated? $reduceStack then
+      pushReduction('parseSexpr1,nil)
+    compulsorySyntax matchAdvanceGlyph "]"
+    pushReduction('parseSexpr1,LIST2VEC popStack1())
+  matchAdvanceGlyph "(" =>
+    stackUpdated?($reduceStack) := false
+    repeatedSyntax('parseSexpr1,function PARSE_-Sexpr1)
+    if parseGlyph "." then
+      compulsorySyntax parseSexpr1()
+      pushReduction('parseSexpr1,append!(popStack2(),popStack1()))
+    if not stackUpdated? $reduceStack then
+      pushReduction('parseSexpr1,nil)
+    compulsorySyntax matchAdvanceGlyph ")"
+  nil
+
+parseSexpr() ==
+  advanceToken()
+  parseSexpr1()
+
+parseData() ==
+  SETQ(LABLASOC,nil)
+  parseSexpr() and
+    pushReduction('parseData,["QUOTE",TRANSLABEL(popStack1(),LABLASOC)])
+
 parseCommand() ==
-  matchAdvanceString '")" =>
+  matchAdvanceString '")" => --FIXME: remove matchAdvanceString
     compulsorySyntax parseSpecialKeyWord()
     compulsorySyntax parseSpecialCommand()
     pushReduction('parseStatement,nil)
@@ -117,7 +248,7 @@ parseTokenOption() ==
   
 parseQualification() ==
   matchAdvanceString '"$" =>
-    compulsorySyntax PARSE_-Primary1()
+    compulsorySyntax parsePrimary1()
     pushReduction('parseQualification,dollarTran(popStack1(),popStack1()))
   nil
 
@@ -130,23 +261,137 @@ parseTokenTail() ==
         $priorToken := tok
   nil
 
+parseSelector() ==
+  $nonblank and currentSymbol() is "." and currentChar() ~= char " "
+    and matchAdvanceGlyph "." =>
+      compulsorySyntax parsePrimaryNoFloat()
+      pushReduction('parseSelector,[popStack2(),popStack1()])
+  parseFloat()
+    or matchAdvanceGlyph "." and compulsorySyntax parsePrimary() =>
+      pushReduction('parseSelector,[popStack2(),popStack1()])
+  nil
+
+parseApplication() ==
+  parsePrimary() =>
+    repeatedSyntax('selectors,function parseSelector)
+    parseApplication() and
+      pushReduction('parseApplication,[popStack2(),popStack1()])
+    true
+  nil
+
+parseOperation($ParseMode,rbp) ==
+  matchCurrentToken 'IDENTIFIER => nil
+  s := currentSymbol()
+  not symbol? s or property(s,$ParseMode) = nil => nil
+  rbp >= parseLeftBindingPowerOf(s,$ParseMode) => nil
+  parseGetSemanticForm(s,$ParseMode,ELEMN(property(s,$ParseMode),5,nil))
+
+parseLedPart rbp ==
+  parseOperation('Led,rbp) and
+    pushReduction('parseLedPart,popStack1())
+
+parseNudPart rbp ==
+  parseOperation('Nud,rbp) or parseReduction() or parseForm() =>
+    pushReduction('parseNudPart,popStack1())
+
+parseExpr rbp ==
+  parseNudPart rbp =>
+    repeatedSyntax('parseExpr,function(() +-> parseLedPart rbp))
+    pushReduction('parseExpr,popStack1())
+  nil
+
 parseInfix() ==
   pushReduction('parseInfix,currentSymbol())
   advanceToken()
   parseTokenTail()
-  compulsorySyntax PARSE_-Expression()
+  compulsorySyntax parseExpression()
   pushReduction('parseInfix,[popStack2(),popStack2(),popStack1()])
 
 parsePrefix() ==
   pushReduction('parsePrefix,currentSymbol())
   advanceToken()
   parseTokenTail()
-  compulsorySyntax PARSE_-Expression()
+  compulsorySyntax parseExpression()
   pushReduction('parsePrefix,[popStack2(),popStack1()])
 
+parseLeftBindingPowerOf(x,p) ==
+  y := property(x,p) => ELEMN(y,3,0)
+  0
+
+parseRightBindingPowerOf(x,p) ==
+  y := property(x,p) => ELEMN(y,4,105)
+  105
+
+parseGetSemanticForm(x,p,y) ==
+  z := EVAL y => z  -- FIXME get rid of EVAL.
+  p = "Nud" => parsePrefix()
+  p = "Led" => parseInfix()
+  nil
+
+parseExpression() ==
+  parseExpr parseRightBindingPowerOf(makeSymbolOf $priorToken,$ParseMode)
+    and pushReduction('parseExpression,popStack1())
+
+parseSegmentTail() ==
+  parseGlyph ".." =>
+    stackUpdated?($reduceStack) := false
+    parseExpression()
+    if not stackUpdated? $reduceStack then
+      pushReduction('segmentTail,nil)
+    pushReduction('parseSegmentTail,["SEGMENT",popStack2(),popStack1()])
+  nil
+
+parseReductionOp() ==
+  s := currentSymbol()
+  if string? s then
+    s := makeSymbol s -- FIXME: abolish string-quoted operators
+  ident? s and property(s,'Led) and matchNextToken('GLIPH,"/") =>
+    pushReduction('parseReductionOp,s)
+    advanceToken()
+    advanceToken()
+    true
+  false
+
+parseReduction() ==
+  parseReductionOp() =>
+    compulsorySyntax parseExpr 1000
+    pushReduction('parseReduction,["%Reduce",popStack2(),popStack1()])
+  nil
+
+parseCategory() ==
+  matchAdvanceKeyword "if" =>
+    compulsorySyntax parseExpression()
+    compulsorySyntax matchAdvanceKeyword "then"
+    compulsorySyntax parseCategory()
+    stackUpdated?($reduceStack) := false
+    matchAdvanceKeyword "else" and compulsorySyntax parseCategory()
+    if not stackUpdated? $reduceStack then
+      pushReduction('alternateCategory,nil)
+    pushReduction('parseCategory,["if",popStack3(),popStack2(),popStack1()])
+  matchAdvanceGlyph "(" =>
+    compulsorySyntax parseCategory()
+    stackUpdated?($reduceStack) := false
+    repeatedSyntax('unnamedCategory,function(() +->
+      matchAdvanceSpecial char ";" and compulsorySyntax parseCategory()))
+    if not stackUpdated? $reduceStack then
+      pushReduction('unnamedCategory,nil)
+    compulsorySyntax matchAdvanceSpecial char ")"
+    pushReduction('parseCategory,["CATEGORY",popStack2(),:popStack1()])
+  g := lineNumber $spadLine
+  parseApplication() or parseOperatorFunctionName() =>
+    matchAdvanceGlyph ":" =>
+      compulsorySyntax parseExpression()
+      pushReduction('parseCategory,["%Signature",popStack2(),popStack1()])
+      recordSignatureDocumentation(nthStack 1,g)
+      true
+    pushReduction('parseCategory,["%Attribute",popStack1()])
+    recordAttributeDocumentation(nthStack 1,g)
+    true
+  nil
+
 parseWith() ==
   matchAdvanceKeyword "with" =>
-    compulsorySyntax PARSE_-Category()
+    compulsorySyntax parseCategory()
     pushReduction('parseWith,["with",popStack1()])
   nil
 
@@ -155,17 +400,8 @@ parseInfixWith() ==
     pushReduction('parseInfixWith,["Join",popStack2(),popStack1()])
 
 parseElseClause() ==
-  currentSymbol() is "if" => PARSE_-Conditional()
-  PARSE_-Expression()
-
-++ domain inlining.  Same syntax as import directive; except
-++ deliberate restriction on naming one type at a time.
-++ -- gdr, 2009-02-28.
-parseInline() ==
-  matchAdvanceKeyword "inline" =>
-    compulsorySyntax PARSE_-Expr 1000
-    pushReduction('parseInline,["%Inline",popStack1()])
-  nil
+  currentSymbol() is "if" => parseConditional()
+  parseExpression()
 
 parseQuantifier() ==
   matchAdvanceKeyword "forall" =>
@@ -176,28 +412,68 @@ parseQuantifier() ==
 
 parseQuantifiedVariable() ==
   parseName() =>
-    compulsorySyntax matchAdvanceString '":"
-    compulsorySyntax PARSE_-Application()
+    compulsorySyntax matchAdvanceGlyph ":"
+    compulsorySyntax parseApplication()
     pushReduction('parseQuantifiedVariable,[":",popStack2(),popStack1()])
   nil
 
+parseQuantifiedVariableList() ==
+  matchAdvanceGlyph "(" =>
+    compulsorySyntax parseQuantifiedVariable()
+    repeatedSyntax('repeatedVars,function(() +->
+      matchAdvanceSpecial char "," and parseQuantifiedVariable()))
+        and pushReduction('parseQuantifiedVariableList,
+              ["%Sequence",popStack2(),:popStack1()])
+    compulsorySyntax matchAdvanceSpecial char ")"
+  nil
+
+++ quantified types.  At the moment, these are used only in
+++ pattern-mathing cases.
+++ -- gdr, 2009-06-14.
+parseScheme() ==
+  parseQuantifier() =>
+    compulsorySyntax parseQuantifiedVariableList()
+    compulsorySyntax matchAdvanceGlyph "."
+    compulsorySyntax parseExpr 200
+    pushReduction('parseScheme,[popStack3(),popStack2(),popStack1()])
+  parseApplication()
+
+parseConditional() ==
+  matchAdvanceKeyword "if" =>
+    compulsorySyntax parseExpression()
+    compulsorySyntax matchAdvanceKeyword "then"
+    compulsorySyntax parseExpression()
+    stackUpdated?($reduceStack) := false
+    if matchAdvanceKeyword "else" then
+      parseElseClause()
+    if not stackUpdated? $reduceStack then
+      pushReduction('elseBranch,nil)
+    pushReduction('parseConditional,["if",popStack3(),popStack2(),popStack1()])
+  nil
+
+parseSemicolon() ==
+  matchAdvanceSpecial char ";" =>
+    parseExpr 82 or pushReduction('parseSemicolon,"/throwAway")
+    pushReduction('parseSemicolon,[";",popStack2(),popStack1()])
+  nil
+
 ++ We should factorize these boilerplates
 parseReturn() ==
   matchAdvanceKeyword "return" =>
-    compulsorySyntax PARSE_-Expression()
+    compulsorySyntax parseExpression()
     pushReduction('parseReturn,["return",popStack1()])
   nil
 
 parseThrow() ==
   matchAdvanceKeyword "throw" =>
-    compulsorySyntax PARSE_-Expression()
+    compulsorySyntax parseExpression()
     pushReduction('parseReturn,["%Throw",popStack1()])
   nil
 
 parseExit() ==
   matchAdvanceKeyword "exit" =>
     x :=
-      PARSE_-Expression() => popStack1()
+      parseExpression() => popStack1()
       "$NoValue"
     pushReduction('parseExit,["exit",x])
   nil
@@ -205,7 +481,7 @@ parseExit() ==
 parseLeave() ==
   matchAdvanceKeyword "leave" =>
     x :=
-      PARSE_-Expression() => popStack1()
+      parseExpression() => popStack1()
       "$NoValue"
     pushReduction('parseLeave,["leave",x])
   nil
@@ -216,12 +492,256 @@ parseJump() ==
     pushReduction('parseJump,s)
   nil
 
+parseForm() ==
+  matchAdvanceKeyword "iterate" =>
+    pushReduction('parseForm,["iterate"])
+  matchAdvanceKeyword "yield" =>
+    compulsorySyntax parseApplication()
+    pushReduction('parseForm,["yield",popStack1()])
+  parseApplication()
+
+parseVariable() ==
+  parseName() =>
+    matchAdvanceGlyph ":" =>
+      compulsorySyntax parseApplication()
+      pushReduction('parseVariable,[":",popStack2(),popStack1()])
+    true
+  parsePrimary()
+
+parseIterator() ==
+  matchAdvanceKeyword "for" =>
+    compulsorySyntax parseVariable()
+    compulsorySyntax matchAdvanceKeyword "in"
+    compulsorySyntax parseExpression()
+    matchAdvanceKeyword "by" and compulsorySyntax parseExpr 200 and
+      pushReduction('parseIterator,["INBY",popStack3(),popStack2(),popStack1()])
+        or pushReduction('parseIterator,["IN",popStack2(),popStack1()])
+    matchAdvanceGlyph "|" and compulsorySyntax parseExpr 111 and
+      pushReduction('parseIterator,["|",popStack1()])
+    true
+  matchAdvanceKeyword "while" =>
+    compulsorySyntax parseExpr 190
+    pushReduction('parseIterator,["WHILE",popStack1()])
+  matchAdvanceKeyword "until" =>
+    compulsorySyntax parseExpr 190
+    pushReduction('parseIterator,["UNTIL",popStack1()])
+  nil
+
+parseIteratorTails() ==
+  matchAdvanceKeyword "repeat" =>
+    stackUpdated?($reduceStack) := false
+    repeatedSyntax('parseIteratorTails,function parseIterator)
+    if not stackUpdated? $reduceStack then
+      pushReduction('crossIterators,nil)
+  repeatedSyntax('parseIteratorTails,function parseIterator)
+
+parseLoop() ==
+  repeatedSyntax('iterators,function parseIterator) =>
+    compulsorySyntax matchAdvanceKeyword "repeat"
+    compulsorySyntax parseExpr 110
+    pushReduction('parseLoop,["REPEAT",:popStack2(),popStack1()])
+  matchAdvanceKeyword "repeat" =>
+    compulsorySyntax parseExpr 110
+    pushReduction('parseLoop,["REPEAT",popStack1()])
+  nil
+
+parseOpenBracket() ==
+  s := currentSymbol()
+  getToken s is "[" =>
+    do 
+      s is ["elt",:.] =>
+        pushReduction('parseOpenBracket,["elt",second s,"construct"])
+      pushReduction('parseOpenBracket,"construct")
+    advanceToken()
+    true
+  false
+
+parseOpenBrace() ==
+  s := currentSymbol()
+  getToken s is "{" =>
+    do 
+      s is ["elt",:.] =>
+        pushReduction('parseOpenBracket,["elt",second s,"brace"])
+      pushReduction('parseOpenBracket,"construct") --FIXME: should be brace
+    advanceToken()
+    true
+  false
+
+parseSequence1() ==
+  do
+    parseExpression() =>
+      pushReduction('parseSequence1,[popStack2(),popStack1()])
+    pushReduction('parseSequence1,[popStack1()])
+  parseIteratorTails() and
+    pushReduction('parseSequence1,["COLLECT",:popStack1(),popStack1()])
+  true
+
+parseSequence() ==
+  parseOpenBracket() =>
+    compulsorySyntax parseSequence1()
+    compulsorySyntax matchAdvanceSpecial char "]"
+  parseOpenBrace() =>
+    compulsorySyntax parseSequence1()
+    compulsorySyntax matchAdvanceSpecial char "}"
+    pushReduction('parseSequence,["brace",popStack1()])
+  nil
+    
+parseEnclosure() ==
+  matchAdvanceGlyph "(" =>
+    parseExpr 6 =>
+      compulsorySyntax matchAdvanceSpecial char ")"
+    matchAdvanceSpecial char ")" =>
+      pushReduction('parseEnclosure,["%Comma"])
+    SPAD__SYNTAX__ERROR()
+  matchAdvanceGlyph "{" =>
+    parseExpr 6 =>
+      compulsorySyntax matchAdvanceSpecial char "}"
+      pushReduction('parseEnclosure,["brace",["construct",popStack1()]])
+    matchAdvanceSpecial char "}" =>
+      pushReduction('parseEnclosure,["brace"])
+    SPAD__SYNTAX__ERROR()
+  matchAdvanceGlyph "[|" =>
+    parseStatement() =>
+      compulsorySyntax matchAdvanceGlyph "|]"
+      pushReduction('parseEnclosure,["[||]",popStack1()])
+    SPAD__SYNTAX__ERROR()
+  nil
+
+parseCatch() ==
+  matchSpecial char ";" and matchKeywordNext "catch" =>
+    advanceToken()
+    advanceToken()
+    compulsorySyntax parseGlyph "("
+    compulsorySyntax parseQuantifiedVariable()
+    compulsorySyntax matchAdvanceSpecial char ")"
+    compulsorySyntax parseGlyph "=>"
+    compulsorySyntax parseExpression()
+    pushReduction('parseCatch,[popStack2(),popStack1()])
+  nil
+
+parseFinally() ==
+  matchSpecial char ";" and matchKeywordNext "finally" =>
+    advanceToken()
+    advanceToken()
+    compulsorySyntax parseExpression()
+  nil
+
+parseTry() ==
+  matchAdvanceKeyword "try" =>
+    compulsorySyntax parseExpression()
+    -- exception handlers: either a finally-expression, or
+    -- a series of catch-expressions optionally followed by
+    -- a finally-expression.
+    parseFinally() =>
+      pushReduction('parseTry,["%Try",popStack2(),nil,popStack1()])
+    compulsorySyntax repeatedSyntax('handlers,function parseCatch) =>
+      stackUpdated?($reduceStack) := false
+      parseFinally()
+      if not stackUpdated? $reduceStack then
+        pushReduction('finalizer,nil)
+      pushReduction('parseTry,["%Try",popStack3(),popStack2(),popStack1()])
+    SPAD__SYNTAX__ERROR()
+  nil
+
+parseMatch() ==
+  matchAdvanceKeyword "case" =>
+    compulsorySyntax parseExpr 400
+    compulsorySyntax matchAdvanceKeyword "is"
+    compulsorySyntax parseExpr 110
+    pushReduction('parseMatch,["%Match",popStack2(),popStack1()])
+  nil
+
+++ domain inlining.  Same syntax as import directive; except
+++ deliberate restriction on naming one type at a time.
+++ -- gdr, 2009-02-28.
+parseInline() ==
+  matchAdvanceKeyword "inline" =>
+    compulsorySyntax parseExpr 1000
+    pushReduction('parseInline,["%Inline",popStack1()])
+  nil
+
+parseImport() ==
+  matchAdvanceKeyword "import" =>
+    compulsorySyntax parseExpr 1000
+    matchAdvanceGlyph ":" =>
+      compulsorySyntax parseExpression()
+      compulsorySyntax matchAdvanceKeyword "from"
+      compulsorySyntax parseExpr 1000
+      pushReduction('parseImport,
+        ["%SignatureImport",popStack3(),popStack2(),popStack1()])
+    stackUpdated?($reduceStack) := false
+    repeatedSyntax('imports,function(() +-> matchAdvanceSpecial char ","
+      and compulsorySyntax parseExpr 1000))
+    if not stackUpdated? $reduceStack then
+      pushReduction('imports,nil)
+    pushReduction('parseImport,["import",popStack2(),:popStack1()])
+  nil
+
+parseStatement() ==
+  parseExpr 0 =>
+    repeatedSyntax('statements,function(() +-> matchAdvanceGlyph ","
+      and compulsorySyntax parseExpr 0)) =>
+        pushReduction('parseStatement,["Series",popStack2(),:popStack1()])
+    true
+  false
+
 parseNewExpr() ==
   matchString '")" =>
     processSynonyms()
     compulsorySyntax parseCommand()
   SETQ(DEFINITION__NAME,currentSymbol())
-  PARSE_-Statement()
+  parseStatement()
+
+--%
+
+isTokenDelimiter() ==
+  symbolMember?(currentSymbol(),[")","END__UNIT","NIL"])
+
+parseTokenList() ==
+  repeatedSyntax('tokenList,function(() +->
+    (isTokenDelimiter() => nil; pushReduction('parseTokenList,currentSymbol());
+      advanceToken(); true)))
+
+parseCommandTail() ==
+  stackUpdated?($reduceStack) := false
+  repeatedSyntax('options,function parseTokenOption)
+  if not stackUpdated? $reduceStack then
+    pushReduction('options,nil)
+  atEndOfLine() and
+    pushReduction('parseCommandTail,[popStack2(),:popStack1()])
+  systemCommand popStack1()
+  true
+
+parseOption() ==
+  matchAdvanceString '")" =>  --FIXME: kill matchAdvanceString
+    compulsorySyntax repeatedSyntax('options,function parsePrimaryOrQM)
+
+parseTokenCommandTail() ==  
+  stackUpdated?($reduceStack) := false
+  repeatedSyntax('options,function parseOption)
+  if not stackUpdated? $reduceStack then
+    pushReduction('options,nil)
+  atEndOfLine() and
+    pushReduction('parseCommandTail,[popStack2(),:popStack1()])
+  systemCommand popStack1()
+  true
+
+parseSpecialCommand() ==
+  matchAdvanceString '"show" =>   --FIXME: kill matchAdvanceString
+    stackUpdated?($reduceStack) := true
+    repeatedSyntax('commands,function(() +-> matchAdvanceString '"?"
+      or parseExpression()))
+    if not stackUpdated? $reduceStack then
+      pushReduction('commdnds,nil)
+    pushReduction('parseSpecialCommand,["show",popStack1()])
+    compulsorySyntax parseCommandTail()
+  symbolMember?(currentSymbol(),$noParseCommands) =>
+    apply(currentSymbol(),nil)
+    true
+  symbolMember?(currentSymbol(),$tokenCommands) and parseTokenList() =>
+    compulsorySyntax parseTokenCommandTail()
+  repeatedSyntax('parseSpecialCommand,function parsePrimaryOrQM) and
+    compulsorySyntax parseCommandTail()
 
 --%
 
@@ -267,3 +787,35 @@ parseSpadFile sourceFile ==
   -- we accumulated the parse trees in reverse order
   reverse! asts
 
+--%
+
+++ Gliphs are symbol clumps. The gliph property of a symbol gives
+++ the tree describing the tokens which begin with that symbol.
+++ The token reader uses the gliph property to determine the longest token.
+++ Thus `:=' is read as one token not as `:' followed by `='.
+for x in [
+  ["|", [")"], ["]"]],_
+  ["*", ["*"]],_
+  ["(", ["|"]],_
+  ["+", ["-", [">"]]],_
+  ["-", [">"]],_
+  ["<", ["="], ["<"]],
+  ["/", ["\"]],_
+  ["\", ["/"]],_
+  [">", ["="], [">"]],_
+  ["=", ["=", [">"]] ,[">"]],_
+  [".", ["."]],_
+  ["^", ["="]],_
+  ["~", ["="]],_
+  ["[", ["|"]],_
+  [":", ["="], ["-"], [":"]]_
+  ] repeat
+     property(first x,'GLIPH) := rest x
+
+++ Generic infix operators
+for x in ["-", "=", "*", "rem", "mod", "quo", "div", "/", "^",
+           "**", "exquo", "+", "-", "<", ">", "<=", ">=", "~=",
+             "and", "or", "/\", "\/", "<<", ">>"] _
+     repeat
+       property(x,'GENERIC) := true
+       
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index 2b883cae..fc517d67 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -42,7 +42,6 @@
 
 ;;; Common  Block
 
-(defvar |$preserveSystemLisplib| t "if nil finalizeLisplib does MA REP")
 (defvar |$reportInstantiations| nil)
 (defvar |$reportEachInstantiation| nil)
 (defvar |$reportCounts| nil)
@@ -55,13 +54,10 @@
 (defvar |$algebraFormat| t "produce 2-d algebra output")
 (defvar |$HiFiAccess| nil "if true maintain history file")
 
-(defvar |boot-NewKEY| NIL)
-
 (DEFVAR _ '&)
 (defvar /EDIT-FM 'A1)
 (defvar /EDIT-FT 'SPAD)
 (defvar /RELEASE '"UNKNOWN")
-(defvar /rp '/RP)
 (defvar error-print)
 (defvar ind)
 (defvar INITCOLUMN 0)
@@ -69,18 +65,14 @@
 (defvar m-chrbuffer)
 (defvar m-chrindex)
 (defvar MARG 0 "Margin for testing by ?OP")
-(defvar NewFlag)
-(defvar ParseMode)
 (defvar RLGENSYMFG NIL)
 (defvar RLGENSYMLST NIL)
 (defvar S-SPADTOK 'SPADSYSTOK)
 (defvar sortpred)
 (defvar SPADSYSKEY '(EOI EOL))
 (defvar STAKCOLUMN -1)
-(defvar xtrans '|boot-new|)
 (defvar |$IOAlist| '((|%i| . (|gauss| 0 1))))
 (defvar |InteractiveMode|)
-(defvar |NewFLAG| t)
 (defvar |uc| 'UC)
 
 (DEFUN INTEGER-BIT (N I) (LOGBITP I N))
@@ -181,7 +173,6 @@
   (COND
     (Q  (/RQ))
     ('T (/RF)) )
-  (FLAG |boot-NewKEY| 'KEY)
   (|terminateSystemCommand|))
 
 (defun /EDIT (L)
@@ -263,17 +254,14 @@
          (S-PROCESS x))))
 
 (defun |New,ENTRY,1| ()
-    (let (ZZ str N RLGENSYMFG RLGENSYMLST |NewFLAG|
+    (let (ZZ str N RLGENSYMFG RLGENSYMLST
           SINGLELINEMODE OK ISID NBLNK COUNT CHR ULCASEFG ($LINESTACK 'BEGIN_UNIT)
-          $TOKSTACK COMMENTCHR TOK LINE BACK INPUTSTREAM XTRANS
+          $TOKSTACK COMMENTCHR TOK LINE BACK INPUTSTREAM
           STACK STACKX TRAPFLAG)
-      (SETQ XTRANS '|boot-New|)
-      (FLAG |boot-NewKEY| 'KEY)
       (PROMPT)
       (SETQ COMMENTCHR 'IGNORE)
       (SETQ INITCOLUMN 0)
       (SETQ SINGLELINEMODE T)   ; SEE NewSYSTOK
-      (SETQ NewFLAG T)
       (SETQ ULCASEFG T)
       (setq STR (|New,ENTRY,2| '|PARSE-NewEXPR| '|process| |$InputStream|))
       (if (/= 0 (setq N (NOTE STR)))
@@ -286,7 +274,6 @@
       (INITIALIZE)
       (SETQ |$previousTime| (TEMPUS-FUGIT))
       (setq ZZ (CONVERSATION '|PARSE-NewExpr| '|process|))
-      (REMFLAG |boot-NewKEY| 'KEY)
       INPUTSTREAM))
 
 (defun INITIALIZE () 
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index 2aefc81d..8349e810 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -700,7 +700,7 @@ $defaultOptimizationLevel == 2
 $OperatorFunctionNames ==
   ["**", "^", "*", "/", "rem", "quo", "mod", "div", "exquo",
     "+", "-", ">", ">=", "=", "~=", "<", "<=", "#", "~", "not",
-     "case", "and", "or", "<<", ">>", "/\", "\/" ]
+     "case", "and", "or", "<<", ">>", "/\", "\/", "..", "by" ]
 
 --%
 %categoryKind == 'category
diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index 7bdf5d13..a7f244d8 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -86,6 +86,8 @@
 	   "tableValue"	  ; value associated with a key in a table
 	   "tableLength"  ; number of entries in the table.
 	   "tableRemove!" ; remove an entry from a table
+	   "ref"
+	   "deref"
 
 	   ;; IO
 	   "$InputStream"
@@ -494,6 +496,13 @@
 (defmacro |tableLength| (ht)
   `(hash-table-count ,ht))
 
+;; -*- Reference -*-
+(defmacro |ref| (v)
+  `(cons ,v nil))
+
+(defmacro |deref| (r)
+  `(car ,r))
+
 ;; -*- File IO -*-
 
 (defparameter |$InputStream| (make-synonym-stream '*standard-input*))