* interp/metalex.lisp (DEFUN-PARSE-TOKEN): Remove.

	Move remaining to parsing.lisp.
	* interp/fnewmeta.lisp (PARSE-IntegerTok): Remove.
	(PARSE-FloatTok): Likewise.
	(PARSE-FormalParameter): Likewise.
	(PARSE-FormalParameterTok): Likewise.
	(PARSE-String): Likewise.
	(PARSE-Name): Likewise.

6 files changed, 233 insertions, 327 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 834af42f..bd27c57d 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,16 @@
 2011-10-10  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/metalex.lisp (DEFUN-PARSE-TOKEN): Remove.
+	Move remaining to parsing.lisp.
+	* interp/fnewmeta.lisp (PARSE-IntegerTok): Remove.
+	(PARSE-FloatTok): Likewise.
+	(PARSE-FormalParameter): Likewise.
+	(PARSE-FormalParameterTok): Likewise.
+	(PARSE-String): Likewise.
+	(PARSE-Name): Likewise.
+
+2011-10-10  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/postpar.boot: Remove functions and references to Scripts.
 
 2011-10-08  Gabriel Dos Reis  <gdr@cs.tamu.edu>
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 8f6feade..85a00d98 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -59,7 +59,7 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	sys-utility.$(FASLEXT)  lexing.$(FASLEXT)        \
 	diagnostics.$(FASLEXT)	                         \
 	union.$(FASLEXT)	sys-macros.$(FASLEXT)	 \
-	macros.$(FASLEXT)	metalex.$(FASLEXT)	 \
+	macros.$(FASLEXT)	                         \
 	parsing.$(FASLEXT)	util.$(FASLEXT)		 \
 	unlisp.$(FASLEXT)	g-util.$(FASLEXT)	\
 	g-opt.$(FASLEXT)	c-util.$(FASLEXT)	\
@@ -322,8 +322,8 @@ server.$(FASLEXT): macros.$(FASLEXT)
 
 ## The old parser component roughtly is:
 ##
-spad-parser.$(FASLEXT): parse.$(FASLEXT)
-parse.$(FASLEXT): metalex.$(FASLEXT) postpar.$(FASLEXT)
+spad-parser.$(FASLEXT): parsing.$(FASLEXT) parse.$(FASLEXT)
+parse.$(FASLEXT): parsing.$(FASLEXT) postpar.$(FASLEXT)
 packtran.$(FASLEXT): sys-macros.$(FASLEXT)
 postpar.$(FASLEXT): macros.$(FASLEXT)
 bootlex.$(FASLEXT): preparse.$(FASLEXT) macros.$(FASLEXT) \
@@ -331,8 +331,7 @@ bootlex.$(FASLEXT): preparse.$(FASLEXT) macros.$(FASLEXT) \
 newaux.$(FASLEXT): macros.$(FASLEXT)
 preparse.$(FASLEXT): fnewmeta.$(FASLEXT)
 fnewmeta.$(FASLEXT): parsing.$(FASLEXT)
-parsing.$(FASLEXT): metalex.$(FASLEXT)
-metalex.$(FASLEXT): lexing.$(FASLEXT) macros.$(FASLEXT)
+parsing.$(FASLEXT): lexing.$(FASLEXT) macros.$(FASLEXT)
 nlib.$(FASLEXT): macros.$(FASLEXT)
 macros.$(FASLEXT): sys-macros.$(FASLEXT) sys-utility.$(FASLEXT)
 lexing.$(FASLEXT): sys-utility.$(FASLEXT) sys-macros.$(FASLEXT)
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
index 8ea479a7..62b1a34d 100644
--- a/src/interp/fnewmeta.lisp
+++ b/src/interp/fnewmeta.lisp
@@ -263,7 +263,7 @@
        (MUST (MATCH-ADVANCE-STRING ")"))))
 
 (DEFUN |PARSE-QuantifiedVariable| ()
-  (AND (|PARSE-Name|)
+  (AND (|parseName|)
        (MUST (MATCH-ADVANCE-STRING ":"))
        (MUST (|PARSE-Application|))
        (MUST (|pushReduction| '|PARSE-QuantifiedVariable|
@@ -438,7 +438,7 @@
 
 
 (DEFUN |PARSE-Variable| ()
-  (OR (AND (|PARSE-Name|)
+  (OR (AND (|parseName|)
 	   (OPTIONAL (AND (MATCH-ADVANCE-STRING ":")
 			  (MUST (|PARSE-Application|))
 			  (MUST (|pushReduction| '|PARSE-Variable|
@@ -493,7 +493,7 @@
 
 
 (DEFUN |PARSE-Label| ()
-  (AND (MATCH-ADVANCE-STRING "<<") (MUST (|PARSE-Name|))
+  (AND (MATCH-ADVANCE-STRING "<<") (MUST (|parseName|))
        (MUST (MATCH-ADVANCE-STRING ">>")))) 
 
 
@@ -603,8 +603,8 @@
                     (MUST (|PARSE-Primary1|))
                     (|pushReduction| '|PARSE-Primary1|
                         (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))
-      (|PARSE-Quad|) (|PARSE-String|) (|PARSE-IntegerTok|)
-      (|PARSE-FormalParameter|)
+      (|PARSE-Quad|) (|parseString|) (|parseInteger|)
+      (|parseFormalParameter|)
       (AND (MATCH-ADVANCE-STRING "'")
            (MUST (AND (MUST (|PARSE-Data|))
                       (|pushReduction| '|PARSE-Primary1| (|popStack1|)))))
@@ -622,11 +622,11 @@
 
 (DEFUN |PARSE-FloatBase| ()
   (OR (AND (INTEGERP (|currentSymbol|)) (CHAR-EQ (|currentChar|) ".")
-           (CHAR-NE (|nextChar|) ".") (|PARSE-IntegerTok|)
+           (CHAR-NE (|nextChar|) ".") (|parseInteger|)
            (MUST (|PARSE-FloatBasePart|)))
       (AND (INTEGERP (|currentSymbol|))
            (CHAR-EQ (CHAR-UPCASE (|currentChar|)) 'E)
-           (|PARSE-IntegerTok|) (|pushReduction| '|PARSE-FloatBase| 0)
+           (|parseInteger|) (|pushReduction| '|PARSE-FloatBase| 0)
            (|pushReduction| '|PARSE-FloatBase| 0))
       (AND (DIGITP (|currentChar|)) (EQ (|currentSymbol|) '|.|)
            (|pushReduction| '|PARSE-FloatBase| 0)
@@ -638,7 +638,7 @@
        (MUST (OR (AND (DIGITP (|currentChar|))
                       (|pushReduction| '|PARSE-FloatBasePart|
                           (|tokenNonblank?| (|currentToken|)))
-                      (|PARSE-IntegerTok|))
+                      (|parseInteger|))
                  (AND (|pushReduction| '|PARSE-FloatBasePart| 0)
                       (|pushReduction| '|PARSE-FloatBasePart| 0)))))) 
 
@@ -648,11 +648,11 @@
     (RETURN
       (OR (AND (MEMBER (|currentSymbol|) '(E |e|))
                (FIND (|currentChar|) "+-") (ACTION (|advanceToken|))
-               (MUST (OR (|PARSE-IntegerTok|)
+               (MUST (OR (|parseInteger|)
                          (AND (MATCH-ADVANCE-STRING "+")
-                              (MUST (|PARSE-IntegerTok|)))
+                              (MUST (|parseInteger|)))
                          (AND (MATCH-ADVANCE-STRING "-")
-                              (MUST (|PARSE-IntegerTok|))
+                              (MUST (|parseInteger|))
                               (|pushReduction| '|PARSE-FloatExponent|
                                   (MINUS (|popStack1|))))
                          (|pushReduction| '|PARSE-FloatExponent| 0))))
@@ -690,31 +690,12 @@
 		      )))
       )) 
 
-
-(DEFUN |PARSE-IntegerTok| () (PARSE-NUMBER)) 
-
-
-(DEFUN |PARSE-FloatTok| ()
-  (AND (PARSE-NUMBER)
-       (|pushReduction| '|PARSE-FloatTok| (|popStack1|)))) 
-
-
-(DEFUN |PARSE-FormalParameter| () (|PARSE-FormalParameterTok|)) 
-
-
-(DEFUN |PARSE-FormalParameterTok| () (PARSE-ARGUMENT-DESIGNATOR)) 
-
-
 (DEFUN |PARSE-Quad| ()
   (AND (MATCH-ADVANCE-STRING "$")
        (|pushReduction| '|PARSE-Quad| '$)))
 
-
-(DEFUN |PARSE-String| () (PARSE-SPADSTRING)) 
-
-
 (DEFUN |PARSE-VarForm| ()
-  (AND (|PARSE-Name|)
+  (AND (|parseName|)
        (OPTIONAL
            (AND (|PARSE-Scripts|)
                 (|pushReduction| '|PARSE-VarForm|
@@ -742,11 +723,6 @@
            (|pushReduction| '|PARSE-ScriptItem|
                (CONS '|PrefixSC| (CONS (|popStack1|) NIL)))))) 
 
-
-(DEFUN |PARSE-Name| ()
-  (AND (PARSE-IDENTIFIER) (|pushReduction| '|PARSE-Name| (|popStack1|)))) 
-
-
 (DEFUN |PARSE-Data| ()
   (AND (ACTION (SETQ LABLASOC NIL)) (|PARSE-Sexpr|)
        (|pushReduction| '|PARSE-Data|
@@ -758,8 +734,8 @@
 
 
 (DEFUN |PARSE-Sexpr1| ()
-  (OR (|PARSE-IntegerTok|)
-      (|PARSE-String|)
+  (OR (|parseInteger|)
+      (|parseString|)
       (AND (|PARSE-AnyId|)
            (OPTIONAL
                (AND (|PARSE-NBGliphTok| '=) (MUST (|PARSE-Sexpr1|))
@@ -771,7 +747,7 @@
            (|pushReduction| '|PARSE-Sexpr1|
                (CONS 'QUOTE (CONS (|popStack1|) NIL))))
       ;; next form disabled -- gdr, 2009-06-15.
-;      (AND (MATCH-ADVANCE-STRING "-") (MUST (|PARSE-IntegerTok|))
+;      (AND (MATCH-ADVANCE-STRING "-") (MUST (|parseInteger|))
 ;           (|pushReduction| '|PARSE-Sexpr1| (MINUS (|popStack1|))))
       (AND (MATCH-ADVANCE-STRING "[")
            (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Sexpr1|))))
@@ -802,11 +778,11 @@
 
 
 (DEFUN |PARSE-AnyId| ()
-  (OR (|PARSE-Name|)
+  (OR (|parseName|)
       (OR (AND (MATCH-STRING "$")
                (|pushReduction| '|PARSE-AnyId| (|currentSymbol|))
                (ACTION (|advanceToken|)))
-          (PARSE-KEYWORD)
+          (|parseToken| 'KEYWORD)
 	  (|PARSE-OperatorFunctionName|))))
 
 
diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp
deleted file mode 100644
index ed1b588e..00000000
--- a/src/interp/metalex.lisp
+++ /dev/null
@@ -1,279 +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.
-
-
-; NAME:         MetaLex.lisp
-; PURPOSE:      Parsing support routines for Meta code
-; CONTENTS:
-;
-;               1. META File Handling
-;               2. META Line Handling
-;               4. META Token Parsing Actions
-;               5. META Error Handling
-
-(IMPORT-MODULE "lexing") 
-(IMPORT-MODULE "macros") 
-(in-package "BOOT")
-
-; 0. Current I/O Stream definition
-
-(defparameter out-stream t "Current output stream.")
-(defparameter File-Closed nil   "Way to stop EOF tests for console input.")
-
-
-; 1. Data structure declarations (defstructs) for parsing objects
-;
-;               A. Line Buffer
-
-; 1A. A Line Buffer
-;
-; The philosophy of lines is that
-;
-;       a) NEXT LINE will always get you a non-blank line or fail.
-;       b) Every line is terminated by a blank character.
-;
-; Hence there is always a current character, because there is never a non-blank line,
-; and there is always a separator character between tokens on separate lines.
-; Also, when a line is read, the character pointer is always positioned ON the first
-; character.
-
-; FUNCTIONS DEFINED IN THIS SECTION:
-;
-;       Line-New-Line, Line-Advance-Char, Line-Past-End-P, Line-At-End-P
-;       Make-Line
-
-(defun Line-Print (line)
-  (format out-stream "~&~5D> ~A~%" (|lineNumber| line) (|lineBuffer| Line))
-  (format out-stream "~v@T^~%" (+ 7 (|lineCurrentIndex| line))))
-
-; *** Next Line
-
-(defun make-string-adjustable (s)
-  (cond ((adjustable-array-p s) s)
-        (t (make-array (array-dimensions s) :element-type 'character
-                       :adjustable t :initial-contents s))))
-
-(defun get-a-line (stream)
-  (if (and (IS-CONSOLE stream) (not |$leanMode|))
-      (|printPrompt|))
-  (let ((ll (read-a-line stream)))
-    (if (stringp ll) (make-string-adjustable ll) ll)))
-
-(defparameter Current-Fragment nil
-  "A string containing remaining chars from readline; needed because
-Symbolics read-line returns embedded newlines in a c-m-Y.")
-
-(defun input-clear () (setq Current-Fragment nil))
-
-(defun Next-Lines-Clear () (setq |$lineStack| nil))
-
-(defun Next-Lines-Show ()
-  (and |$lineStack| (format t "Currently preparsed lines are:~%~%"))
-  (mapcar #'(lambda (line)
-              (format t "~&~5D> ~A~%" (car line) (cdr Line)))
-          |$lineStack|))
-
-
-; 3. Routines for handling lexical scanning
-;
-; Lexical scanning of tokens is performed off of the current line.  No
-; token can span more than 1 line.  All real I/O is handled in a line-oriented
-; fashion (in a slight paradox) below the character level.  All character
-; routines implicitly assume the parameter |$spadLine|.  We do not make
-; |$spadLine| an explicit optional parameter for reasons of efficiency.
-
-(defmacro current-line-print () '(Line-Print |$spadLine|))
-
-(defmacro current-line-show ()
-  `(if (|linePastEnd?| |$spadLine|)
-       (format t "~&The current line is empty.~%")
-       (progn (format t "~&The current line is:~%~%")
-              (current-line-print))))
-
-(defmacro current-line-clear () `(|lineClear!| |$spadLine|))
-
-(defun read-a-line (&optional (stream t))
-  (let (cp)
-    (if (and Current-Fragment (> (length Current-Fragment) 0))
-        (let ((line (with-input-from-string
-                      (s Current-Fragment :index cp :start 0)
-                      (read-line s nil nil))))
-          (setq Current-Fragment (subseq Current-Fragment cp))
-          line)
-        (prog nil
-              (if (stream-eof in-stream)
-                  (progn (setq File-Closed t *EOF* t)
-                         (|lineNewLine!| (make-string 0) |$spadLine|)
-                         (return nil)))
-              (if (setq Current-Fragment (read-line stream))
-                  (return (read-a-line stream)))))))
-
-; *** Print New Line
-
-(defparameter Printer-Line-Stack (|makeStack|)
-  "Stack of output listing lines waiting to print. [local to PRINT-NEW-LINE]")
-
-(defparameter Read-Quietly nil
-  "Whether or not to produce an output listing. [local to PRINT-NEW-LINE]")
-
-(defun Print-New-Line (string &optional (strm |$OutputStream|))
-  "Makes output listings."
-  (if Read-Quietly (|stackPush!| (copy-tree string) Printer-Line-Stack)
-      (progn (mapc #'(lambda (x) (format strm "; ~A~%" x) (terpri))
-                   (|reverse!| (|stackStore| Printer-Line-Stack)))
-             (|stackClear!| Printer-Line-Stack)
-             (format strm "~&; ~A~%" string))))
-
-; 1C. Token
-(defun Token-Print (token)
-  (format out-stream "(token (symbol ~S) (type ~S))~%"
-          (|tokenSymbol| token) (|tokenType| token)))
-
-(defun reduce-stack-show ()
-  (let ((store (|stackStore| |$reduceStack|))
-        (*print-pretty* t))
-    (if store
-        (progn (format t "~%Reduction stack contains:~%")
-               (mapcar #'(lambda (x)
-			   (if (eq (type-of x) 'token)
-                               (describe x)
-			     (print x)))
-                       (|stackStore| |$reduceStack|)))
-        (format t "~%There is nothing on the reduction stack.~%"))))
-
- 
-; *** 3. META Token Handling
- 
-; STRING: "'"  { Chars - "'" }* "'"
-; BSTRING: "[" ... "]*"
-; ID: letters, _ and then numbers
-; NUMBER: digits, ., digits, e, +-, digits
-
-; 3A (1) Token Handling.
-
-; Tokens are acquired from a stream of characters.  Lexical analysis is performed
-; by the functiond Get Token.  One-token lookahead is maintained in variables
-; |$CurrentToken| and |$NextToken| by procedures Current Token, Next Token, and
-; Advance Token.  The functions Match Current Token and Match Next Token recognize
-; classes of tokens, by type, or by type and symbol.  The current and next tokens
-; can be shoved back on the input stream (to the current line) with Unget-Tokens.
-
-(defmacro Defun-Parse-Token (token)
-  `(defun ,(intern (concatenate 'string "PARSE-" (string token))) ()
-     (let* ((tok (|matchCurrentToken| ',token))
-            (symbol (if tok (|tokenSymbol| tok))))
-       (if tok (progn (|pushReduction|
-                        ',(intern (concatenate 'string (string token)
-                                               "-TOKEN"))
-                        (copy-tree symbol))
-                      (|advanceToken|)
-                      t)))))
-
-(defun token-stack-show ()
-  (if (= |$validTokens| 0) (format t "~%There are no valid tokens.~%")
-      (format t "~%The number of valid tokens is ~S.~%" |$validTokens|))
-  (if (> |$validTokens| 0)
-      (progn (format t "The current token is~%")
-             (describe |$currentToken|)))
-  (if (> |$validTokens| 1)
-      (progn (format t "The next token is~%")
-             (describe |$nextToken|)))
-  (if (|tokenType| |$priorToken|)
-      (progn (format t "The prior token was~%")
-             (describe |$priorToken|))))
-
- 
-(defun-parse-token STRING)
-(defun-parse-token BSTRING)
-(defun-parse-token IDENTIFIER)
-(defun-parse-token NUMBER)
- 
-; Parsing of operator tokens depends on tables initialized by BOTTOMUP.LISP
-
-(defun-parse-token SPADSTRING)
-(defun-parse-token KEYWORD)
-(defun-parse-token ARGUMENT-DESIGNATOR)
-
-(defun |PARSE-OperatorFunctionName| ()
-  (let ((id (|makeSymbolOf| (or (|matchCurrentToken| 'keyword)
-				(|matchCurrentToken| 'gliph)
-				(|matchCurrentToken| 'special-char)))))
-    (when (and id (member id |$OperatorFunctionNames|))
-      (|pushReduction| '|PARSE-OperatorFunctionName| id)
-      (action (|advanceToken|)))))
- 
-(defun make-adjustable-string (n)
-  (make-array (list n) :element-type 'character :adjustable t))
- 
-(defun get-number-token (token)
-  "Take a number off the input stream."
-  (prog ((buf (make-adjustable-string 0)))
-	nu1 
-	(suffix (|currentChar|) buf)                     ; Integer part
-        (let ((next-chr (|nextChar|)))
-          (cond ((digitp next-chr)
-                 (|advanceChar!|)
-                 (go nu1))))
-        (|advanceChar!|) 
-	(return (|tokenInstall| (read-from-string buf)
-			       'number token
-			       (size buf) ;used to keep track of digit count
-			       ))))
- 
-; *** 4. META Auxiliary Parsing Actions
- 
-(defparameter Meta_Prefix nil)
- 
-(defun make-defun (nametok vars body)
-  (let ((name (INTERN (STRCONC |META_PREFIX| nametok))))
-    (if vars
-        `(DEFUN ,name ,vars (declare (special . ,vars)) ,body)
-        `(DEFUN ,name ,vars ,body))))
- 
-(defun print-fluids (fluids)
-  (terpri out-stream)
-  (mapcar #'(lambda (x) (format out-stream "~&(DEFPARAMETER ~S NIL)~%" x)) fluids)
-  (terpri out-stream))
- 
-(defun print-package (package)
-  (format out-stream "~&~%(IN-PACKAGE ~S )~%~%" package))
- 
-(defun set-prefix (prefix)  (setq META_PREFIX prefix))
- 
-(defun print-rule (x)  (print x out-stream) (format out-stream "~%~%"))
- 
-; *** 5. META Error Handling
-
-(defparameter $num_of_meta_errors 0)
-
-(defparameter Meta_Errors_Occurred nil  "Did any errors occur")
diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp
index 42d5efbc..b8ca2142 100644
--- a/src/interp/parsing.lisp
+++ b/src/interp/parsing.lisp
@@ -76,9 +76,185 @@
 ;       NEWMETA.LISP:  Boot parsing
 
 
-(import-module "metalex")
+(import-module "lexing")
+(import-module "macros")
+
 (in-package "BOOT")
 
+
+; 0. Current I/O Stream definition
+
+(defparameter out-stream t "Current output stream.")
+(defparameter File-Closed nil   "Way to stop EOF tests for console input.")
+
+
+; 1. Data structure declarations (defstructs) for parsing objects
+;
+;               A. Line Buffer
+
+; 1A. A Line Buffer
+;
+; The philosophy of lines is that
+;
+;       a) NEXT LINE will always get you a non-blank line or fail.
+;       b) Every line is terminated by a blank character.
+;
+; Hence there is always a current character, because there is never a non-blank line,
+; and there is always a separator character between tokens on separate lines.
+; Also, when a line is read, the character pointer is always positioned ON the first
+; character.
+
+; FUNCTIONS DEFINED IN THIS SECTION:
+;
+;       Line-New-Line, Line-Advance-Char, Line-Past-End-P, Line-At-End-P
+;       Make-Line
+
+(defun Line-Print (line)
+  (format out-stream "~&~5D> ~A~%" (|lineNumber| line) (|lineBuffer| Line))
+  (format out-stream "~v@T^~%" (+ 7 (|lineCurrentIndex| line))))
+
+; *** Next Line
+
+(defun make-string-adjustable (s)
+  (cond ((adjustable-array-p s) s)
+        (t (make-array (array-dimensions s) :element-type 'character
+                       :adjustable t :initial-contents s))))
+
+(defun get-a-line (stream)
+  (if (and (IS-CONSOLE stream) (not |$leanMode|))
+      (|printPrompt|))
+  (let ((ll (read-a-line stream)))
+    (if (stringp ll) (make-string-adjustable ll) ll)))
+
+(defparameter Current-Fragment nil
+  "A string containing remaining chars from readline; needed because
+Symbolics read-line returns embedded newlines in a c-m-Y.")
+
+(defun input-clear () (setq Current-Fragment nil))
+
+(defun Next-Lines-Clear () (setq |$lineStack| nil))
+
+(defun Next-Lines-Show ()
+  (and |$lineStack| (format t "Currently preparsed lines are:~%~%"))
+  (mapcar #'(lambda (line)
+              (format t "~&~5D> ~A~%" (car line) (cdr Line)))
+          |$lineStack|))
+
+
+; 3. Routines for handling lexical scanning
+;
+; Lexical scanning of tokens is performed off of the current line.  No
+; token can span more than 1 line.  All real I/O is handled in a line-oriented
+; fashion (in a slight paradox) below the character level.  All character
+; routines implicitly assume the parameter |$spadLine|.  We do not make
+; |$spadLine| an explicit optional parameter for reasons of efficiency.
+
+(defmacro current-line-print () '(Line-Print |$spadLine|))
+
+(defmacro current-line-show ()
+  `(if (|linePastEnd?| |$spadLine|)
+       (format t "~&The current line is empty.~%")
+       (progn (format t "~&The current line is:~%~%")
+              (current-line-print))))
+
+(defmacro current-line-clear () `(|lineClear!| |$spadLine|))
+
+(defun read-a-line (&optional (stream t))
+  (let (cp)
+    (if (and Current-Fragment (> (length Current-Fragment) 0))
+        (let ((line (with-input-from-string
+                      (s Current-Fragment :index cp :start 0)
+                      (read-line s nil nil))))
+          (setq Current-Fragment (subseq Current-Fragment cp))
+          line)
+        (prog nil
+              (if (stream-eof in-stream)
+                  (progn (setq File-Closed t *EOF* t)
+                         (|lineNewLine!| (make-string 0) |$spadLine|)
+                         (return nil)))
+              (if (setq Current-Fragment (read-line stream))
+                  (return (read-a-line stream)))))))
+
+; *** Print New Line
+
+(defparameter Printer-Line-Stack (|makeStack|)
+  "Stack of output listing lines waiting to print. [local to PRINT-NEW-LINE]")
+
+(defparameter Read-Quietly nil
+  "Whether or not to produce an output listing. [local to PRINT-NEW-LINE]")
+
+(defun Print-New-Line (string &optional (strm |$OutputStream|))
+  "Makes output listings."
+  (if Read-Quietly (|stackPush!| (copy-tree string) Printer-Line-Stack)
+      (progn (mapc #'(lambda (x) (format strm "; ~A~%" x) (terpri))
+                   (|reverse!| (|stackStore| Printer-Line-Stack)))
+             (|stackClear!| Printer-Line-Stack)
+             (format strm "~&; ~A~%" string))))
+
+; 1C. Token
+(defun Token-Print (token)
+  (format out-stream "(token (symbol ~S) (type ~S))~%"
+          (|tokenSymbol| token) (|tokenType| token)))
+
+(defun reduce-stack-show ()
+  (let ((store (|stackStore| |$reduceStack|))
+        (*print-pretty* t))
+    (if store
+        (progn (format t "~%Reduction stack contains:~%")
+               (mapcar #'(lambda (x)
+			   (if (eq (type-of x) 'token)
+                               (describe x)
+			     (print x)))
+                       (|stackStore| |$reduceStack|)))
+        (format t "~%There is nothing on the reduction stack.~%"))))
+
+(defun token-stack-show ()
+  (if (= |$validTokens| 0) (format t "~%There are no valid tokens.~%")
+      (format t "~%The number of valid tokens is ~S.~%" |$validTokens|))
+  (if (> |$validTokens| 0)
+      (progn (format t "The current token is~%")
+             (describe |$currentToken|)))
+  (if (> |$validTokens| 1)
+      (progn (format t "The next token is~%")
+             (describe |$nextToken|)))
+  (if (|tokenType| |$priorToken|)
+      (progn (format t "The prior token was~%")
+             (describe |$priorToken|))))
+ 
+; Parsing of operator tokens depends on tables initialized by BOTTOMUP.LISP
+
+(defun |PARSE-OperatorFunctionName| ()
+  (let ((id (|makeSymbolOf| (or (|matchCurrentToken| 'keyword)
+				(|matchCurrentToken| 'gliph)
+				(|matchCurrentToken| 'special-char)))))
+    (when (and id (member id |$OperatorFunctionNames|))
+      (|pushReduction| '|PARSE-OperatorFunctionName| id)
+      (action (|advanceToken|)))))
+ 
+(defun make-adjustable-string (n)
+  (make-array (list n) :element-type 'character :adjustable t))
+ 
+(defun get-number-token (token)
+  "Take a number off the input stream."
+  (prog ((buf (make-adjustable-string 0)))
+	nu1 
+	(suffix (|currentChar|) buf)                     ; Integer part
+        (let ((next-chr (|nextChar|)))
+          (cond ((digitp next-chr)
+                 (|advanceChar!|)
+                 (go nu1))))
+        (|advanceChar!|) 
+	(return (|tokenInstall| (read-from-string buf)
+			       'number token
+			       (size buf) ;used to keep track of digit count
+			       ))))
+ 
+; *** 5. META Error Handling
+
+(defparameter $num_of_meta_errors 0)
+
+(defparameter Meta_Errors_Occurred nil  "Did any errors occur")
+
 (defun IOStreams-Show ()
   (format t "~&Input is coming from ~A, and output is going to ~A.~%"
            (or (streamp in-stream) "the keyboard")
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index 719f7258..3ab5c41a 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -42,10 +42,33 @@
 -- -- gdr/2007-11-02
 --
 
-import metalex
+import parsing
 import parse
 namespace BOOT
 
+--%
+
+parseToken tt ==
+  tok := matchCurrentToken tt =>
+    pushReduction(makeSymbol strconc(symbolName tt,'"Token"),tokenSymbol tok)
+    advanceToken()
+    true
+  false
+
+parseString() ==
+  parseToken 'SPADSTRING
+
+parseInteger() ==
+  parseToken 'NUMBER
+
+parseName() ==
+  parseToken 'IDENTIFIER and pushReduction('parseName,popStack1())
+  
+parseFormalParameter() ==
+  parseToken 'ARGUMENT_-DESIGNATOR
+
+--%
+
 ++ Given a pathname to a source file containing Spad code, returns
 ++ a list of (old) AST objects representing the toplevel expressions
 ++ in that file.