* interp/preparse.lisp: Remove.

	* interp/spad-parser.boot: Do not include.  Import lexing instead.
	* interp/Makefile.in: Adjust.

3 files changed, 88 insertions, 177 deletions

diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 810dd0eb..49513340 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -100,7 +100,6 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	server.$(FASLEXT)	setvars.$(FASLEXT)	\
 	sfsfun-l.$(FASLEXT)	sfsfun.$(FASLEXT)	\
 	slam.$(FASLEXT)		                        \
-	preparse.$(FASLEXT)	                   	\
 	spad.$(FASLEXT)		termrw.$(FASLEXT)	\
 	trace.$(FASLEXT)	word.$(FASLEXT)        	\
 	fortcall.$(FASLEXT) 	i-parser.$(FASLEXT) 	\
@@ -315,12 +314,11 @@ server.$(FASLEXT): sys-macros.$(FASLEXT)
 
 ## The old parser component roughtly is:
 ##
-spad-parser.$(FASLEXT): parse.$(FASLEXT) preparse.$(FASLEXT)
+spad-parser.$(FASLEXT): parse.$(FASLEXT) lexing.$(FASLEXT)
 parse.$(FASLEXT): postpar.$(FASLEXT)
 packtran.$(FASLEXT): sys-macros.$(FASLEXT)
 postpar.$(FASLEXT): sys-macros.$(FASLEXT)
 newaux.$(FASLEXT): sys-macros.$(FASLEXT)
-preparse.$(FASLEXT): lexing.$(FASLEXT)
 nlib.$(FASLEXT): sys-macros.$(FASLEXT)
 lexing.$(FASLEXT): sys-utility.$(FASLEXT) sys-macros.$(FASLEXT) \
 	io.$(FASLEXT)
diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp
deleted file mode 100644
index 6165e40b..00000000
--- a/src/interp/preparse.lisp
+++ /dev/null
@@ -1,173 +0,0 @@
-;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-;; All rights reserved.
-;; Copyright (C) 2007-2012, 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:    Pre-Parsing Code
-;; PURPOSE: BOOT lines are massaged by preparse to make them easier to parse:
-;;        1. Trailing -- comments are removed (this is already done, actually).
-;;        2. Comments between { and } are removed.
-;;        3. BOOT code is column-sensitive. Code which lines up columnarly is
-;;           parenthesized and semicolonized accordingly.  For example,
-;;
-;;                a
-;;                        b
-;;                        c
-;;                                d
-;;                e
-;;
-;;           becomes
-;;
-;;                a
-;;                        (b;
-;;                         c
-;;                                d)
-;;                e
-;;
-;;           Note that to do this correctly, we also need to keep track of
-;;           parentheses already in the code.
- 
-
-
-(IMPORT-MODULE "lexing")
- 
-(in-package "BOOT")
- 
-; Global storage
- 
-(defparameter |$preparseLastLine| ()            "Most recently read line.")
-(defparameter |$preparseReportIfTrue| NIL         "Should we print listings?")
-(defparameter $IOIndex 0                        "Number of latest terminal input line.")
- 
-(DEFPARAMETER TOK NIL)
-(DEFPARAMETER DEFINITION_NAME NIL)
-
-(defun Initialize-Preparse (rd)
-  (SETF (|readerLineNumber| rd) 0)
-  (setq |$preparseLastLine| (|readLine| (|readerInput| rd))))
- 
-(defvar $skipme)
- 
-(defun |preparse1| (rd)
- (PROG (NUM A I L PSLOC
-        INSTRING PCOUNT COMSYM STRSYM OPARSYM CPARSYM N NCOMSYM
-        (SLOC -1) (CONTINUE NIL)  (PARENLEV 0) (NCOMBLOCK ())
-        (LINES ()) (LOCS ()) (NUMS ()) functor  )
- READLOOP (DCQ (NUM . A) (|preparseReadLine| rd))
-         (cond ((|atEndOfUnit?| A)
-                (|preparseEcho| (|readerPendingLines| rd))
-                (COND ((NULL LINES) (RETURN NIL))
-                      (NCOMBLOCK
-                       (|findCommentBlock| NIL NUMS LOCS NCOMBLOCK)))
-                (RETURN (|pairList| (|reverse!| NUMS)
-			 (|parsePiles| (|reverse!| LOCS) (|reverse!| LINES))))))
-         (cond ((and (NULL LINES) (> (LENGTH A) 0) (EQ (CHAR A 0) #\) ))
-                ; this is a command line, don't parse it
-                (|preparseEcho| (|readerPendingLines| rd))
-                (setq |$preparseLastLine| nil) ;don't reread this line
-                (SETQ LINE a)
-                (CATCH |$SpadReaderTag| (|doSystemCommand| (subseq LINE 1)))
-                (GO READLOOP)))
-         (setq L (LENGTH A))
-         (if (EQ L 0)
-	     (GO READLOOP))
-         (setq PSLOC SLOC)
-         (setq I 0 
-	       INSTRING ()
-	       PCOUNT 0)
- STRLOOP (setq STRSYM (OR (|findChar| #\" A I) L))
-         (setq COMSYM (OR (|findString| "--" A I) L))
-         (setq NCOMSYM (OR (|findString| "++" A I) L))
-         (setq OPARSYM (OR (|findChar| #\( A I) L))
-         (setq CPARSYM (OR (|findChar| #\) A I) L))
-         (setq N (MIN STRSYM COMSYM NCOMSYM OPARSYM CPARSYM))
-         (cond ((= N L)
-		(GO NOCOMS))
-               ((|escaped?| A N))
-               ((= N STRSYM) (setq INSTRING (NOT INSTRING)))
-               (INSTRING)
-               ((= N COMSYM)
-		(setq A (subseq A 0 N))
-		(GO NOCOMS)) ; discard trailing comment
-               ((= N NCOMSYM)
-                (setq SLOC (|indentationLocation| A))
-                (COND
-                  ((= SLOC N)
-                   (COND ((AND NCOMBLOCK (NOT (= N (CAR NCOMBLOCK))))
-                          (|findCommentBlock| NUM NUMS LOCS NCOMBLOCK)
-                          (SETQ NCOMBLOCK NIL)))
-                   (SETQ NCOMBLOCK (CONS N (CONS A (IFCDR NCOMBLOCK))))
-                   (SETQ A ""))
-                  ('T 
-		   (|readerDeferLine| rd (STRCONC (|makeString| N #\Space)
-						  (SUBSTRING A N NIL)))
-		   (SETF (|readerLineNumber| rd) (1- (|readerLineNumber| rd)))
-		   (SETQ A (SUBSEQ A 0 N))))
-		(GO NOCOMS))
-               ((= N OPARSYM) (setq PCOUNT (1+ PCOUNT)))
-               ((= N CPARSYM) (setq PCOUNT (1- PCOUNT))))
-         (setq I (1+ N))
-         (GO STRLOOP)
- NOCOMS  (setq SLOC (|indentationLocation| A))
-         (setq A (|trimTrailingBlank| A))
-         (cond ((NULL SLOC)
-		(setq SLOC PSLOC)
-		(GO READLOOP)))
-         (cond ((EQ (ELT A (|maxIndex| A)) #\_)
-                (setq CONTINUE T a (subseq A (|maxIndex| A))))
-               ((setq CONTINUE NIL)))
-         (if (and (null LINES) (= SLOC 0)) ;;test for skipping constructors
-             (if (and |$byConstructors|
-                      (null (|findString| "==>" a))
-                      (not (member (setq functor (intern
-                                    (substring a 0 (STRPOSL ": (=" A 0 NIL))))
-                                   |$byConstructors|)))
-                 (setq $skipme 't)
-               (progn (push functor |$constructorsSeen|)
-		      (setq $skipme nil))))
-         (when (and LINES (EQL SLOC 0))
-             (IF (AND NCOMBLOCK (NOT (ZEROP (CAR NCOMBLOCK))))
-		 (|findCommentBlock| NUM NUMS LOCS NCOMBLOCK))
-             (RETURN (|pairList| (|reverse!| NUMS)
-                        (|parsePiles| (|reverse!| LOCS) (|reverse!| LINES)))))
-         (cond ((> PARENLEV 0)
-		(PUSH NIL LOCS)
-		(setq SLOC PSLOC)
-		(GO REREAD)))
-         (COND (NCOMBLOCK
-                (|findCommentBlock| NUM NUMS LOCS NCOMBLOCK)
-                (setq NCOMBLOCK ())))
-         (PUSH SLOC LOCS)
- REREAD  (|preparseEcho| (|readerPendingLines| rd))
-         (PUSH A LINES)
-         (PUSH NUM NUMS)
-         (setq PARENLEV (+ PARENLEV PCOUNT))
-         (GO READLOOP)))
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index 2d49ad59..0363ff97 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -42,7 +42,7 @@
 -- -- gdr/2007-11-02
 --
 
-import preparse
+import lexing
 import parse
 namespace BOOT
 
@@ -195,6 +195,92 @@ parsePrint l ==
     formatToStdout '"~%"
   nil
 
+preparse1 rd ==
+  sloc := -1
+  parenlev := 0
+  ncomblock := nil
+  lines := nil
+  locs := nil
+  nums := nil
+  instring := false
+  repeat
+    [num,:l] := preparseReadLine rd
+    atEndOfUnit? l =>
+      preparseEcho readerPendingLines rd
+      lines = nil => return nil
+      if ncomblock ~= nil then
+        findCommentBlock(nil,nums,locs,ncomblock)
+      return pairList(reverse! nums,parsePiles(reverse! locs,reverse! lines))
+    lines = nil and #l > 0 and l.0 = char ")" =>
+      preparseEcho readerPendingLines rd
+      $preparseLastLine := nil
+      SETQ(LINE,l)
+      CATCH($SpadReaderTag,doSystemCommand SUBSEQ(LINE,1))
+    sz := #l
+    sz = 0 => nil
+    -- analyze the line just read
+    psloc := sloc
+    i := 0
+    instring := false
+    pcount := 0
+    repeat
+      strsym := charPosition(char "_"",l,i)
+      comsym := findString('"--",l,i) or sz
+      ncomsym := findString('"++",l,i) or sz
+      oparsym := charPosition(char "(",l,i)
+      cparsym := charPosition(char ")",l,i)
+      n := MIN(strsym,comsym,ncomsym,oparsym,cparsym)
+      do
+        n = sz => leave nil -- empty line
+        escaped?(l,n) => nil
+        n = strsym => instring := not instring
+        instring => nil
+        n = comsym => -- comment
+          l := SUBSEQ(l,0,n)
+          leave nil
+        n = ncomsym => -- description
+          sloc := indentationLocation l
+          if sloc = n then
+            if ncomblock ~= nil and n ~= first ncomblock then
+              findCommentBlock(num,nums,locs,ncomblock)
+              ncomblock := nil
+            ncomblock := [n,l,:IFCDR ncomblock]
+            l := '""
+          else
+            readerDeferLine(rd,strconc(makeString(n,char " "),subString(l,n)))
+            readerLineNumber(rd) := readerLineNumber rd - 1
+            l := SUBSEQ(l,0,n)
+          leave nil
+        n = oparsym => pcount := pcount + 1
+        n = cparsym => pcount := pcount - 1
+      i := n + 1
+    sloc := indentationLocation l
+    sloc = nil => sloc := psloc
+    l := trimTrailingBlank l
+    if lines = nil and sloc = 0 then
+      if $byConstructors and findString('"==>",l) = nil and
+        not symbolMember?(functor := makeSymbol subString(l,0,STRPOSL('": (=",l,0,nil)),$byConstructors) then
+          $SKIPME := true
+      else
+        $constructorsSeen := [functor,:$constructorsSeen]
+        $SKIPME := false
+    lines ~= nil and sloc = 0 =>
+      if ncomblock ~= nil and first ncomblock ~= 0 then
+        findCommentBlock(num,nums,locs,ncomblock)
+      return pairList(reverse! nums,parsePiles(reverse! locs,reverse! lines))
+    do
+      parenlev > 0 =>
+        locs := [nil,:locs]
+        sloc := psloc
+      if ncomblock ~= nil then
+        findCommentBlock(num,nums,locs,ncomblock)
+        ncomblock := nil
+      locs := [sloc,:locs]
+    preparseEcho readerPendingLines rd
+    lines := [l,:lines]
+    nums := [num,:nums]
+    parenlev := parenlev + pcount
+
 preparse rd ==
   $COMBLOCKLIST := nil
   $SKIPME := false