aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/Makefile.in11
-rw-r--r--src/interp/debug.lisp4
-rw-r--r--src/interp/lexing.boot16
-rw-r--r--src/interp/parsing.lisp284
-rw-r--r--src/interp/preparse.lisp2
-rw-r--r--src/interp/spad-parser.boot13
-rw-r--r--src/interp/spad.lisp8
-rw-r--r--src/interp/util.lisp4
-rw-r--r--src/interp/vmlisp.lisp9
9 files changed, 49 insertions, 302 deletions
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 5c8aa886..217a1873 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -60,7 +60,7 @@ OBJS= boot-pkg.$(FASLEXT) types.$(FASLEXT) \
diagnostics.$(FASLEXT) \
union.$(FASLEXT) sys-macros.$(FASLEXT) \
macros.$(FASLEXT) \
- parsing.$(FASLEXT) util.$(FASLEXT) \
+ util.$(FASLEXT) \
unlisp.$(FASLEXT) g-util.$(FASLEXT) \
g-opt.$(FASLEXT) c-util.$(FASLEXT) \
astr.$(FASLEXT) bits.$(FASLEXT) \
@@ -317,12 +317,11 @@ server.$(FASLEXT): macros.$(FASLEXT)
## The old parser component roughtly is:
##
spad-parser.$(FASLEXT): parse.$(FASLEXT) preparse.$(FASLEXT)
-parse.$(FASLEXT): parsing.$(FASLEXT) postpar.$(FASLEXT)
+parse.$(FASLEXT): postpar.$(FASLEXT)
packtran.$(FASLEXT): sys-macros.$(FASLEXT)
postpar.$(FASLEXT): macros.$(FASLEXT)
newaux.$(FASLEXT): macros.$(FASLEXT)
-preparse.$(FASLEXT): parsing.$(FASLEXT)
-parsing.$(FASLEXT): lexing.$(FASLEXT) macros.$(FASLEXT)
+preparse.$(FASLEXT): lexing.$(FASLEXT)
nlib.$(FASLEXT): macros.$(FASLEXT)
macros.$(FASLEXT): sys-macros.$(FASLEXT) sys-utility.$(FASLEXT)
lexing.$(FASLEXT): sys-utility.$(FASLEXT) sys-macros.$(FASLEXT) \
@@ -352,7 +351,7 @@ dq.$(FASLEXT): types.$(FASLEXT)
## General support and utilities.
daase.$(FASLEXT): sys-utility.$(FASLEXT)
-debug.$(FASLEXT): macros.$(FASLEXT) parsing.$(FASLEXT)
+debug.$(FASLEXT): macros.$(FASLEXT) lexing.$(FASLEXT)
spad.$(FASLEXT): spad-parser.$(FASLEXT) postpar.$(FASLEXT) debug.$(FASLEXT)
monitor.$(FASLEXT): macros.$(FASLEXT)
sfsfun-l.$(FASLEXT): sys-macros.$(FASLEXT)
@@ -373,7 +372,7 @@ word.$(FASLEXT): g-util.$(FASLEXT)
g-util.$(FASLEXT): ggreater.$(FASLEXT) macros.$(FASLEXT) daase.$(FASLEXT)
g-cndata.$(FASLEXT): sys-macros.$(FASLEXT) c-util.$(FASLEXT)
msg.$(FASLEXT): sys-macros.$(FASLEXT) astr.$(FASLEXT)
-util.$(FASLEXT): parsing.$(FASLEXT)
+util.$(FASLEXT): lexing.$(FASLEXT)
fname.$(FASLEXT): macros.$(FASLEXT)
sys-macros.$(FASLEXT): diagnostics.$(FASLEXT) union.$(FASLEXT)
buildom.$(FASLEXT): buildom.boot sys-macros.$(FASLEXT) c-util.$(FASLEXT)
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 746f10c4..c1db2f22 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -44,7 +44,7 @@
; PURPOSE: Debugging hooks for Boot code
(import-module "macros")
-(import-module "parsing")
+(import-module "lexing")
(in-package "BOOT")
(defvar S-SPADKEY NIL) ;" this is augmented by MAKESPADOP"
@@ -1139,7 +1139,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
(COND ((AND (EQ DEBUGMODE 'YES) (NOT(CONSOLEINPUTP IN-STREAM)))
(SPAD_LONG_ERROR))
((SPAD_SHORT_ERROR)))
- (IOClear)
+ (|ioClear!|)
(throw 'spad_reader nil))
(defun SPAD_LONG_ERROR ()
diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot
index 3143b23c..aeaccf9d 100644
--- a/src/interp/lexing.boot
+++ b/src/interp/lexing.boot
@@ -121,9 +121,15 @@ nextLine st ==
SETQ(LINE,l)
$currentLine := l
+nextLinesClear!() ==
+ $lineStack := nil
+
++ Current input stream.
IN_-STREAM := 'T
+++ Current output stream
+OUT_-STREAM := 'T
+
++ Advances IN-STREAM, invoking Next Line if necessary
advanceChar!() ==
repeat
@@ -603,3 +609,13 @@ popStack4() ==
nthStack n ==
reductionValue stackStore($reduceStack).(n - 1)
+
+
+--%
+
+ioClear!() ==
+ lineClear! $spadLine
+ tokenStackClear!()
+ reduceStackClear()
+ $SPAD => nextLinesClear!()
+ nil
diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp
deleted file mode 100644
index a6a321e7..00000000
--- a/src/interp/parsing.lisp
+++ /dev/null
@@ -1,284 +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: META/LISP Parser Generator and Lexical Analysis Utilities (Parsing)
-;
-; PURPOSE: This package provides routines to support the Metalanguage
-; translator writing system. Metalanguage is described
-; in META/LISP, R.D. Jenks, Tech Report, IBM T.J. Watson Research Center,
-; 1969. Familiarity with this document is assumed.
-;
-; The parser generator itself is described in either the file
-; MetaBoot.lisp (hand-coded version) or the file MetaMeta.lisp (machine
-; generated from self-descriptive Meta code), both of which load themselves
-; into package Parsing.
-
-; CONTENTS:
-;
-; 2. Recursive descent parsing support routines
-; A. Stacking and retrieving reductions of rules.
-; B. Applying metagrammatical elements of a production (e.g., Star).
-;
-; 3. Routines for handling lexical scanning
-;
-; A. Manipulating the token stack and reading tokens
-; B. Error handling
-; C. Constructing parsing procedures
-; D. Managing rule sets
-;
-; 4. Tracing routines
-;
-; 5. Routines for inspecting and resetting total I/O system state
-;
-
-
-(import-module "lexing")
-(import-module "macros")
-
-(in-package "BOOT")
-
-
-; 0. Current I/O Stream definition
-
-(MAKEPROP 'END_UNIT 'KEY 'T)
-
-(defparameter out-stream t "Current output stream.")
-
-(defun Line-Print (line)
- (format out-stream "~&~5D> ~A~%" (|lineNumber| line) (|lineBuffer| Line))
- (format out-stream "~v@T^~%" (+ 7 (|lineCurrentIndex| 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 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|))
-
-; *** 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|))))
-
-(defun make-adjustable-string (n)
- (make-array (list n) :element-type 'character :adjustable t))
-
-; *** 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")
- (or (streamp out-stream) "the screen"))
- (format t "~:[~;The current input stream is logically closed.~%~]~%"
- (|eof?| in-stream)))
-
-(defmacro IOStreams-Set (input output) `(setq in-stream ,input out-stream ,output))
-
-(defmacro IOStreams-Clear (&optional (in t) (out t))
- `(progn (and (streamp in-stream) (close in-stream))
- (and (streamp out-stream) (close out-stream))
- (IOStreams-Set ,in ,out)))
-
-; 2B. Routines for applying certain metagrammatical elements
-; of a production (e.g., Star).
-
-; Must means that if it is not present in the token stream, it is a syntax error.
-
-; FUNCTIONS DEFINED IN THIS SECTION:
-;
-; Star, Bang, Must, Optional, Action
-
-(defmacro Star (lab prod)
-
-"Succeeds if there are one or more of PROD, stacking as one unit
-the sub-reductions of PROD and labelling them with LAB.
-E.G., (Star IDs (parse-id)) with A B C will stack (3 IDs (A B C)),
-where (parse-id) would stack (1 ID (A)) when applied once."
-
- `(prog ((oldstacksize (|stackSize| |$reduceStack|)))
- (if (not ,prod) ;(progn (format t "~&Star failed for ~A.~%" ',lab) (return nil)))
- (return nil))
- loop (if (not ,prod)
- (let* ((newstacksize (|stackSize| |$reduceStack|))
- (number-of-new-reductions (- newstacksize oldstacksize)))
-; (format t "~&Starring ~A with ~D new reductions.~%"
-; ',lab number-of-new-reductions)
- (if (> number-of-new-reductions 0)
- (return (do ((i 0 (1+ i)) (accum nil))
- ((= i number-of-new-reductions)
- (|pushReduction| ',lab accum)
-; (format t "~&Star accumulated ~D reductions.~%"
-; (length accum))
- (return t))
- (push (|popStack1|) accum)))
- (return t)))
- (go loop))))
-
-(defmacro Bang (lab prod)
-
-"If the execution of prod does not result in an increase in the size of
-the stack, then stack a NIL. Return the value of prod."
-
- `(progn (setf (|stackUpdated?| |$reduceStack|) nil)
- (let* ((prodvalue ,prod)
- (updated (|stackUpdated?| |$reduceStack|)))
- (if updated
- (progn ; (format t "~&Banged ~A and I think the stack is updated!~%" ',lab)
- prodvalue)
- (progn (|pushReduction| ',lab nil)
- prodvalue)))))
-
-(defmacro must (dothis &optional (this-is nil) (in-rule nil))
- `(or ,dothis (spad_syntax_error ,this-is ,in-rule)))
-
-; Optional means that if it is present in the token stream, that is a good thing,
-; otherwise don't worry (like [ foo ] in BNF notation).
-
-(defun Optional (dothis) (or dothis t))
-
-; Action is something we do as a consequence of successful parsing; it is
-; inserted at the end of the conjunction of requirements for a successful
-; parse, and so should return T.
-
-(defun action (dothis) (or dothis t))
-
-; 3B. Error handling
-
-(defparameter line nil)
-
-; 5. Routines for inspecting and resetting total I/O system state
-;
-; The package largely assumes that:
-;
-; A. One I/O stream pair is in effect at any moment.
-; B. There is a Current Line
-; C. There is a Current Token and a Next Token
-; D. There is a Reduction Stack
-;
-; This state may be examined and reset with the procedures IOSTAT and IOCLEAR.
-
-(defun IOStat ()
- "Tell me what the current state of the parsing world is."
- (current-line-show)
- (if $SPAD (next-lines-show))
- (token-stack-show)
- nil)
-
-(defun IOClear (&optional (in t) (out t))
- ;(IOStreams-clear in out)
- (current-line-clear)
- (|tokenStackClear!|)
- (|reduceStackClear|)
- (if $SPAD (next-lines-clear))
- nil)
-
-;; auxiliary functions needed by the parser
-
-(Defun FLOATEXPID (X &aux S)
- (if (AND (|ident?| X) (char= (char-upcase (ELT (SETQ S (PNAME X)) 0)) #\E)
- (> (LENGTH S) 1)
- (SPADREDUCE AND 0 (COLLECT (STEP I 1 1 (|maxIndex| S))
- (DIGITP (ELT S I)))))
- (READ-FROM-STRING S t nil :start 1)
- NIL))
diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp
index 0bea0768..f0edee7c 100644
--- a/src/interp/preparse.lisp
+++ b/src/interp/preparse.lisp
@@ -57,7 +57,7 @@
-(IMPORT-MODULE "parsing")
+(IMPORT-MODULE "lexing")
(in-package "BOOT")
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index e934e2b9..266d966c 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -293,6 +293,15 @@ parseFloatBase() ==
pushReduction('parseBase,0)
nil
+floatExponent x ==
+ ident? x =>
+ s := symbolName x
+ charUpcase stringChar(s,0) = char "E" and #s > 1
+ and (and/[DIGITP stringChar(s,i) for i in 1..maxIndex s]) =>
+ READ_-FROM_-STRING(s,true,nil,KEYWORD::START,1)
+ nil
+ nil
+
parseFloatExponent() ==
not ident? currentSymbol() => nil
symbolMember?(currentSymbol(),'(e E)) and
@@ -304,7 +313,7 @@ parseFloatExponent() ==
compulsorySyntax parseInteger()
pushReduction('parseFloatExponent,-popStack1())
pushReduction('parseFloatExponent,0)
- g := FLOATEXPID currentSymbol() =>
+ g := floatExponent currentSymbol() =>
advanceToken()
pushReduction('parseFloatExponent,g)
nil
@@ -997,7 +1006,7 @@ parseSpadFile sourceFile ==
-- we accumulated the parse trees in reverse order
reverse! asts
finally -- clean up the mess, and get out of here
- IOCLEAR(IN_-STREAM, OUT_-STREAM)
+ ioClear!()
SHUT IN_-STREAM
--%
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index cc25cde5..185a4bd8 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -77,9 +77,8 @@
(defun init-boot/spad-reader ()
(setq $SPAD_ERRORS (VECTOR 0 0 0))
(setq SPADERRORSTREAM |$OutputStream|)
- (Next-Lines-Clear)
- (setq |$lineStack| nil)
- (ioclear))
+ (|nextLinesClear!|)
+ (|ioClear!|))
(defun spad (&optional
(*spad-input-file* nil)
@@ -132,9 +131,8 @@
(let ((|$OutputStream| out-stream))
(|translateSpad| parseout))
(format out-stream "~&")))
- ;(IOClear in-stream out-stream)
))))
- (IOClear in-stream out-stream)))
+ (|ioClear!|)))
(if *spad-input-file* (shut in-stream))
(if *spad-output-file* (shut out-stream)))
T))
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index 4132d434..7f74ed54 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -50,7 +50,7 @@
(IMPORT-MODULE "vmlisp")
-(import-module "parsing")
+(import-module "lexing")
(in-package "BOOT")
@@ -265,7 +265,7 @@
(DECLARE (SPECIAL LINE))
(if (and (> (LENGTH LINE) 0) (EQ (CHAR LINE 0) #\) ))
(|processSynonyms|))
- (ioclear)
+ (|ioClear!|)
(LET* ((|$lineStack| (LIST (CONS 1 LINE)))
($SPAD T)
(PARSEOUT (PROG2 (|parseNewExpr|) (|popStack1|))))
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 9d569cbf..832bb8ae 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -1222,3 +1222,12 @@
(function-lambda-expression func)
(declare (ignore l c))
n)))
+
+(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 make-adjustable-string (n)
+ (make-array (list n) :element-type 'character :adjustable t))
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 20:34:14 +0000