aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2012-06-10 01:31:02 +0000
committerdos-reis <gdr@axiomatics.org>2012-06-10 01:31:02 +0000
commita016645fb84079852fb1464d770252af687d57f5 (patch)
treebac0396954ac21db96d6ed464df783d99d02b49f /src
parent85a46b94c83297511b221180f7391cd777f252a0 (diff)
downloadopen-axiom-a016645fb84079852fb1464d770252af687d57f5.tar.gz
* interp/preparse.lisp: Remove.
* interp/spad-parser.boot: Do not include. Import lexing instead. * interp/Makefile.in: Adjust.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog6
-rw-r--r--src/boot/ast.boot5
-rw-r--r--src/boot/strap/ast.clisp6
-rw-r--r--src/boot/strap/parser.clisp6
-rw-r--r--src/interp/Makefile.in4
-rw-r--r--src/interp/preparse.lisp173
-rw-r--r--src/interp/spad-parser.boot88
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