From a016645fb84079852fb1464d770252af687d57f5 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sun, 10 Jun 2012 01:31:02 +0000 Subject: * interp/preparse.lisp: Remove. * interp/spad-parser.boot: Do not include. Import lexing instead. * interp/Makefile.in: Adjust. --- src/ChangeLog | 6 ++ src/boot/ast.boot | 5 +- src/boot/strap/ast.clisp | 6 +- src/boot/strap/parser.clisp | 6 +- src/interp/Makefile.in | 4 +- src/interp/preparse.lisp | 173 -------------------------------------------- src/interp/spad-parser.boot | 88 +++++++++++++++++++++- 7 files changed, 106 insertions(+), 182 deletions(-) delete mode 100644 src/interp/preparse.lisp (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index f74a591e..c0621c85 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2012-06-09 Gabriel Dos Reis + + * interp/preparse.lisp: Remove. + * interp/spad-parser.boot: Do not include. Import lexing instead. + * interp/Makefile.in: Adjust. + 2012-06-09 Gabriel Dos Reis * interp/io.boot (%Reader): Add idx field. 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 -- cgit v1.2.3