* interp/preparse.lisp: Remove.

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

7 files changed, 106 insertions, 182 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index f74a591e..c0621c85 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,11 @@
 2012-06-09  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/preparse.lisp: Remove.
+	* interp/spad-parser.boot: Do not include.  Import lexing instead.
+	* interp/Makefile.in: Adjust.
+
+2012-06-09  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/io.boot (%Reader): Add idx field.
 	* interp/preparse.lisp ($INDEX): Remove.  Adjust users.
 
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index b7ae91b5..8d5a6d57 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -1113,7 +1113,10 @@ shoeCompTran1(x,fluidVars,locVars,dollarVars) ==
         deref(locVars) := [l,:deref locVars]
       x
     x
-  U is "%Leave" => (x.op := "RETURN"; x)
+  U is "%Leave" =>
+    x.op := "RETURN"
+    x.args := shoeCompTran1(x.args,fluidVars,locVars,dollarVars)
+    x
   U in '(PROG LAMBDA) =>
     newbindings := nil
     for y in second x repeat
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 9c271751..eea10d77 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1895,7 +1895,11 @@
                              (CONS |l| (|deref| |locVars|)))))
                    |x|)))
                 (T |x|)))))
-            ((EQ U '|%Leave|) (RPLACA |x| 'RETURN) |x|)
+            ((EQ U '|%Leave|) (RPLACA |x| 'RETURN)
+             (RPLACD |x|
+                     (|shoeCompTran1| (CDR |x|) |fluidVars| |locVars|
+                                      |dollarVars|))
+             |x|)
             ((|symbolMember?| U '(PROG LAMBDA)) (SETQ |newbindings| NIL)
              (LET ((|bfVar#1| (CADR |x|)) (|y| NIL))
                (LOOP
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 1b05fd82..985611d3 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -502,7 +502,7 @@
               ((|bpEqPeek| |ps| 'COLON) (|bpRestore| |ps| |a|)
                (|bpRequire| |ps| #'|bpSignature|)
                (OR (|bpExportItemTail| |ps|) T))
-              (T (|bpRestore| |ps| |a|) (|bpTypeAliasDefition| |ps|))))
+              (T (|bpRestore| |ps| |a|) (|bpTypeAliasDefinition| |ps|))))
             (T NIL))))))
 
 (DEFUN |bpExportItemList| (|ps|) (|bpListAndRecover| |ps| #'|bpExportItem|))
@@ -555,7 +555,7 @@
   (AND (|bpEqKey| |ps| 'NAMESPACE) (OR (|bpName| |ps|) (|bpDot| |ps|))
        (|bpPush| |ps| (|bfNamespace| (|bpPop1| |ps|)))))
 
-(DEFUN |bpTypeAliasDefition| (|ps|)
+(DEFUN |bpTypeAliasDefinition| (|ps|)
   (AND (|bpTypeName| |ps|) (|bpEqKey| |ps| 'TDEF) (|bpLogical| |ps|)
        (|bpPush| |ps| (|%TypeAlias| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
 
@@ -1024,7 +1024,7 @@
        ((|bpExit| |ps|)
         (COND ((|bpEqPeek| |ps| 'DEF) (|bpRestore| |ps| |a|) (|bpDef| |ps|))
               ((|bpEqPeek| |ps| 'TDEF) (|bpRestore| |ps| |a|)
-               (|bpTypeAliasDefition| |ps|))
+               (|bpTypeAliasDefinition| |ps|))
               (T T)))
        (T (|bpRestore| |ps| |a|) NIL))))))
 
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