aboutsummaryrefslogtreecommitdiff
path: root/src/interp/bootlex.lisp.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-09-10 03:30:13 +0000
committerdos-reis <gdr@axiomatics.org>2007-09-10 03:30:13 +0000
commitb8d7cd431a779551cf2c6eac94f6b4463db97273 (patch)
treee52ce35bd564ae64db8623410f6414f0d16f72ea /src/interp/bootlex.lisp.pamphlet
parent383b2385eb1f3fb00f5856a2ddf593ec42c03189 (diff)
downloadopen-axiom-b8d7cd431a779551cf2c6eac94f6b4463db97273.tar.gz
* Makefile.pamphlet (DEP): Adjust path to comp.lisp.
(${DEPSYS}): Likewise for def.lisp, bootlex.lisp, postprop.lisp, metalex.lisp. Use |compileLispFile| instead of COMPILE-FILE. * Makefile.in: Regenerate. * union.lisp: New. * union.lisp.pamphlet: Move content to union.lisp. Remove. * obey.lisp: New. * obey.lisp.pamphlet: Move content to obey.lisp. Remove. * nspadaux.lisp: New. * nspadaux.lisp.pamphlet: Move content to nspadaux.lisp. Remove. * fname.lisp: New. * fname.lisp.pamphlet: Move content to fname.lisp. Remove. * def.lisp: New. * def.lisp.pamphlet: Move content to def.lisp. Remove. * comp.lisp: New. * comp.lisp.pamphlet: Move content to comp.lisp. Remove. * bootlex.lisp: New. * bootlex.lisp.pamphlet: Move content to bootlex.lisp. Remove. * postprop.lisp: New. * postprop.lisp.pamphlet: Move content to postprop.lisp. Remove. * metalex.lisp: New. * metalex.lisp.pamphlet: Move content to metalex.lisp. Remove. * parsing.lisp: New. * parsing.lisp.pamphlet: Move content to parsing.lisp. Remove.
Diffstat (limited to 'src/interp/bootlex.lisp.pamphlet')
-rw-r--r--src/interp/bootlex.lisp.pamphlet475
1 files changed, 0 insertions, 475 deletions
diff --git a/src/interp/bootlex.lisp.pamphlet b/src/interp/bootlex.lisp.pamphlet
deleted file mode 100644
index 9913b93d..00000000
--- a/src/interp/bootlex.lisp.pamphlet
+++ /dev/null
@@ -1,475 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp bootlex.lisp}
-\author{Timothy Daly}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\section{License}
-<<license>>=
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; 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.
-
-@
-<<*>>=
-<<license>>
-
-; NAME: BootLex.lisp
-; PURPOSE: Parsing support routines for Boot and Spad code
-; CONTENTS:
-;
-; 0. Global parameters
-; 1. BOOT File Handling
-; 2. BOOT Line Handling
-; 3. BOOT Token Handling
-; 4. BOOT Token Parsing Actions
-; 5. BOOT Error Handling
-
-(in-package "BOOT")
-
-; *** 0. Global parameters
-
-(defparameter Boot-Line-Stack nil "List of lines returned from PREPARSE.")
-
-(defun Next-Lines-Clear () (setq Boot-Line-Stack nil))
-
-(defun Next-Lines-Show ()
- (and Boot-Line-Stack (format t "Currently preparsed lines are:~%~%"))
- (mapcar #'(lambda (line)
- (format t "~&~5D> ~A~%" (car line) (cdr Line)))
- Boot-Line-Stack))
-
-; *** 1. BOOT file handling
-
-(defun init-boot/spad-reader ()
- (setq $SPAD_ERRORS (VECTOR 0 0 0))
- (setq SPADERRORSTREAM *standard-output*)
- (setq XTokenReader 'get-BOOT-token)
- (setq Line-Handler 'next-BOOT-line)
- (setq Meta_Error_Handler 'spad_syntax_error)
- (setq File-Closed nil)
- (Next-Lines-Clear)
- (setq Boot-Line-Stack nil)
- (ioclear))
-
-(defmacro test (x &rest y)
- `(progn
- (setq spaderrorstream t)
- (in-boot)
- (initialize-preparse *terminal-io*)
- (,(intern (strconc "PARSE-" x)) . ,y)))
-
-(defun |oldParserAutoloadOnceTrigger| () nil)
-
-(defun print-defun (name body)
- (let* ((sp (assoc 'vmlisp::compiler-output-stream vmlisp::optionlist))
- (st (if sp (cdr sp) *standard-output*)))
- (if (and (is-console st) (symbolp name) (fboundp name)
- (not (compiled-function-p (symbol-function name))))
- (compile name))
- (when (or |$PrettyPrint| (not (is-console st)))
- (print-full body st) (force-output st))))
-
-(defun boot-parse-1 (in-stream
- &aux
- (Echo-Meta nil)
- (current-fragment nil)
- ($INDEX 0)
- ($LineList nil)
- ($EchoLineStack nil)
- ($preparse-last-line nil)
- ($BOOT T)
- (*EOF* NIL)
- (OPTIONLIST NIL))
- (declare (special echo-meta *comp370-apply* *EOF* File-Closed
- $index $linelist $echolinestack $preparse-last-line))
- (init-boot/spad-reader)
- (let* ((Boot-Line-Stack (PREPARSE in-stream))
- (parseout (prog2 (|PARSE-Expression|) (pop-stack-1)) ) )
- ;(setq parseout (|new2OldLisp| parseout))
- ; (setq parseout (DEF-RENAME parseout))
- ; (DEF-PROCESS parseout)
- parseout))
-
-(defun boot (&optional
- (*boot-input-file* nil)
- (*boot-output-file* nil)
- &aux
- (Echo-Meta t)
- ($BOOT T)
- (XCape #\_)
- (File-Closed NIL)
- (*EOF* NIL)
- (OPTIONLIST NIL)
- (*fileactq-apply* (function print-defun))
- (*comp370-apply* (function print-defun)))
- (declare (special echo-meta *comp370-apply* *EOF* File-Closed XCape))
- (setq |$InteractiveMode| NIL)
- (init-boot/spad-reader)
- (with-open-stream
- (in-stream (if *boot-input-file* (open *boot-input-file* :direction :input)
- *standard-input*))
- (initialize-preparse in-stream)
- (with-open-stream
- (out-stream (if *boot-output-file*
- (open *boot-output-file* :direction :output)
- #-:cmulisp (make-broadcast-stream *standard-output*)
- #+:cmulisp *standard-output*
- ))
- (when *boot-output-file*
- (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot -*-~%~%")
- (print-package "BOOT"))
- (loop (if (and (not File-Closed)
- (setq Boot-Line-Stack (PREPARSE in-stream)))
- (progn
- (|PARSE-Expression|)
- (let ((parseout (pop-stack-1)) )
- (setq parseout (|new2OldLisp| parseout))
- (setq parseout (DEF-RENAME parseout))
- (let ((*standard-output* out-stream))
- (DEF-PROCESS parseout))
- (format out-stream "~&")
- (if (null parseout) (ioclear)) ))
- (return nil)))
- (if *boot-input-file*
- (format out-stream ";;;Boot translation finished for ~a~%"
- (namestring *boot-input-file*)))
- (IOClear in-stream out-stream)))
- T)
-
-(defun spad (&optional
- (*spad-input-file* nil)
- (*spad-output-file* nil)
- &aux
- ;; (Echo-Meta *spad-input-file*)
- ;; (*comp370-apply* (function print-and-eval-defun))
- (*comp370-apply* (function print-defun))
- (*fileactq-apply* (function print-defun))
- ($SPAD T)
- ($BOOT nil)
- (XCape #\_)
- (OPTIONLIST nil)
- (*EOF* NIL)
- (File-Closed NIL)
- ;; ($current-directory "/spad/libraries/")
- (/editfile *spad-input-file*)
- (|$noSubsumption| |$noSubsumption|)
- in-stream out-stream)
- (declare (special echo-meta /editfile *comp370-apply* *EOF*
- File-Closed Xcape |$noSubsumption|))
- (setq |$InteractiveMode| nil)
- ;; only rebind |$InteractiveFrame| if compiling
- (progv (if (not |$InteractiveMode|) '(|$InteractiveFrame|))
- (if (not |$InteractiveMode|)
- (list (|addBinding|
- '|$DomainsInScope|
- `((FLUID . |true|)
- (|special| . ,(COPY-TREE |$InitialDomainsInScope|)))
- (|addBinding| '|$Information| NIL (|makeInitialModemapFrame|)))))
- (init-boot/spad-reader)
- (unwind-protect
- (progn
- (setq in-stream (if *spad-input-file*
- (open *spad-input-file* :direction :input)
- *standard-input*))
- (initialize-preparse in-stream)
- (setq out-stream (if *spad-output-file*
- (open *spad-output-file* :direction :output)
- *standard-output*))
- (when *spad-output-file*
- (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot -*-~%~%")
- (print-package "BOOT"))
- (setq curoutstream out-stream)
- (loop
- (if (or *eof* file-closed) (return nil))
- (catch 'SPAD_READER
- (if (setq Boot-Line-Stack (PREPARSE in-stream))
- (let ((LINE (cdar Boot-Line-Stack)))
- (declare (special LINE))
- (|PARSE-NewExpr|)
- (let ((parseout (pop-stack-1)) )
- (when parseout
- (let ((*standard-output* out-stream))
- (S-PROCESS parseout))
- (format out-stream "~&")))
- ;(IOClear in-stream out-stream)
- )))
- (IOClear in-stream out-stream)))
- (if *spad-input-file* (shut in-stream))
- (if *spad-output-file* (shut out-stream)))
- T))
-
-(defun READ-BOOT (FN FM TO)
- (let (($boot t)) (READ-SPAD1 FN 'BOOT FM TO)))
-
-(defun READ-SPAD1 (FN FT FM TO)
- (LET ((STRM IN-STREAM))
- (SETQ $MAXLINENUMBER 0)
- (SETQ $SPAD_ERRORS (VECTOR 0 0 0))
- (SETQ IN-STREAM (open (strconc fm ">" fn "." ft) :direction :input))
- ($ERASE (LIST FN 'ERROR 'A))
- (SETQ OUT-STREAM (if TO (open to :direction :output) OUT-STREAM))
- (SETQ SPADERRORSTREAM (open (strconc "a>" fn ".error") :direction :output))
- (READ-SPAD-1)
- (close SPADERRORSTREAM)
- (SETQ IN-STREAM STRM)
- (OR (EQUAL #(0 0 0) $SPAD_ERRORS)
- (|sayBrightly| (LIST '|%b| (ELT $SPAD_ERRORS 0) '|%d| '|syntax errors|
- '|%l| '|%b| (ELT $SPAD_ERRORS 1) '|%d| '|precompilation errors|
- '|%l| '|%b| (ELT $SPAD_ERRORS 2) '|%d| '|semantic errors| '|%l|)))
- (+ (ELT $SPAD_ERRORS 0) (ELT $SPAD_ERRORS 1) (ELT $SPAD_ERRORS 2))))
-
-(defun READBOOT ()
- (let (form expr ($BOOT 'T))
- (declare (special $BOOT))
- (ADVANCE-TOKEN)
- (|PARSE-Expression|)
- ;; (|pp| (setq form (|postTransform| (FIRST STACK))))
- (|pp| (setq form (|postTransform| (pop-STACK-1))))
- (setq EXPR (DEF-RENAME form))
- (DEF-PROCESS EXPR)
- (TERSYSCOMMAND)))
-
-; *** 2. BOOT Line Handling ***
-
-; See the file PREPARSE.LISP for the hard parts of BOOT line processing.
-
-(defun next-BOOT-line (&optional (in-stream t))
-
- "Get next line, trimming trailing blanks and trailing comments.
-One trailing blank is added to a non-blank line to ease between-line
-processing for Next Token (i.e., blank takes place of return). Returns T
-if it gets a non-blank line, and NIL at end of stream."
-
- (if Boot-Line-Stack
- (let ((Line-Number (caar Boot-Line-Stack))
- (Line-Buffer (suffix #\Space (cdar Boot-Line-Stack))))
- (pop Boot-Line-Stack)
- (Line-New-Line Line-Buffer Current-Line Line-Number)
- (setq |$currentLine| (setq LINE Line-Buffer))
- Line-Buffer)))
-
-; *** 3. BOOT Token Handling ***
-
-(defparameter xcape #\_ "Escape character for Boot code.")
-
-(defun get-BOOT-token (token)
-
- "If you have an _, go to the next line.
-If you have a . followed by an integer, get a floating point number.
-Otherwise, get a .. identifier."
-
- (if (not (boot-skip-blanks))
- nil
- (let ((token-type (boot-token-lookahead-type (current-char))))
- (case token-type
- (eof (token-install nil '*eof token nonblank))
- (escape (advance-char)
- (get-boot-identifier-token token t))
- (argument-designator (get-argument-designator-token token))
- (id (get-boot-identifier-token token))
- (num (get-number-token token))
- (string (get-SPADSTRING-token token))
- (special-char (get-special-token token))
- (t (get-gliph-token token token-type))))))
-
-(defun boot-skip-blanks ()
- (setq nonblank t)
- (loop (let ((cc (current-char)))
- (if (not cc) (return nil))
- (if (eq (boot-token-lookahead-type cc) 'white)
- (progn (setq nonblank nil) (if (not (advance-char)) (return nil)))
- (return t)))))
-
-(defun boot-token-lookahead-type (char)
- "Predicts the kind of token to follow, based on the given initial character."
- (cond ((not char) 'eof)
- ((char= char #\_) 'escape)
- ((and (char= char #\#) (digitp (next-char))) 'argument-designator)
- ((digitp char) 'num)
- ((and (char= char #\$) $boot
- (alpha-char-p (next-char))) 'id)
- ((or (char= char #\%) (char= char #\?)
- (char= char #\!) (alpha-char-p char)) 'id)
- ((char= char #\") 'string)
- ((member char
- '(#\Space #\Tab #\Return)
- :test #'char=) 'white)
- ((get (intern (string char)) 'Gliph))
- (t 'special-char)))
-
-(defun get-argument-designator-token (token)
- (advance-char)
- (get-number-token token)
- (token-install (intern (strconc "#" (format nil "~D" (token-symbol token))))
- 'argument-designator token nonblank))
-
-(defvar Keywords '(|or| |and| |isnt| |is| |otherwise| |when| |where|
- |has| |with| |add| |case| |in| |by| |pretend| |mod|
- |exquo| |div| |quo| |else| |rem| |then| |suchthat|
- |if| |yield| |iterate| |from| |exit| |leave| |return|
- |not| |unless| |repeat| |until| |while| |for| |import|)
-
-
-
-"Alphabetic literal strings occurring in the New Meta code constitute
-keywords. These are recognized specifically by the AnyId production,
-GET-BOOT-IDENTIFIER will recognize keywords but flag them
-as keywords.")
-
-(defun get-boot-identifier-token (token &optional (escaped? nil))
- "An identifier consists of an escape followed by any character, a %, ?,
-or an alphabetic, followed by any number of escaped characters, digits,
-or the chracters ?, !, ' or %"
- (prog ((buf (make-adjustable-string 0))
- (default-package NIL))
- (suffix (current-char) buf)
- (advance-char)
- id (let ((cur-char (current-char)))
- (cond ((char= cur-char XCape)
- (if (not (advance-char)) (go bye))
- (suffix (current-char) buf)
- (setq escaped? t)
- (if (not (advance-char)) (go bye))
- (go id))
- ((and (null default-package)
- (char= cur-char #\'))
- (setq default-package buf)
- (setq buf (make-adjustable-string 0))
- (if (not (advance-char)) (go bye))
- (go id))
- ((or (alpha-char-p cur-char)
- (digitp cur-char)
- (member cur-char '(#\% #\' #\? #\!) :test #'char=))
- (suffix (current-char) buf)
- (if (not (advance-char)) (go bye))
- (go id))))
- bye (if (and (stringp default-package)
- (or (not (find-package default-package)) ;; not a package name
- (every #'(lambda (x) (eql x #\')) buf))) ;;token ends with ''
- (setq buf (concatenate 'string default-package "'" buf)
- default-package nil))
- (setq buf (intern buf (or default-package "BOOT")))
- (return (token-install
- buf
- (if (and (not escaped?)
- (member buf Keywords :test #'eq))
- 'keyword 'identifier)
- token
- nonblank))))
-
-(defun get-gliph-token (token gliph-list)
- (prog ((buf (make-adjustable-string 0)))
- (suffix (current-char) buf)
- (advance-char)
- loop (setq gliph-list (assoc (intern (string (current-char))) gliph-list))
- (if gliph-list
- (progn (suffix (current-char) buf)
- (pop gliph-list)
- (advance-char)
- (go loop))
- (let ((new-token (intern buf)))
- (return (token-install (or (get new-token 'renametok) new-token)
- 'gliph token nonblank))))))
-
-(defun get-SPADSTRING-token (token)
- "With TOK=\" and ABC\" on IN-STREAM, extracts and stacks string ABC"
- (PROG ((BUF (make-adjustable-string 0)))
- (if (char/= (current-char) #\") (RETURN NIL) (advance-char))
- (loop
- (if (char= (current-char) #\") (return nil))
- (SUFFIX (if (char= (current-char) XCape)
- (advance-char)
- (current-char))
- BUF)
- (if (null (advance-char)) ;;end of line
- (PROGN (|sayBrightly| "Close quote inserted") (RETURN nil)))
- )
- (advance-char)
- (return (token-install (copy-seq buf) ;should make a simple string
- 'spadstring token))))
-
-; **** 4. BOOT token parsing actions
-
-; Parsing of operator tokens depends on tables initialized by BOTTOMUP.LISP
-
-(defun-parse-token SPADSTRING)
-(defun-parse-token KEYWORD)
-(defun-parse-token ARGUMENT-DESIGNATOR)
-
-(defun TRANSLABEL (X AL) (TRANSLABEL1 X AL) X)
-
-(defun TRANSLABEL1 (X AL)
- "Transforms X according to AL = ((<label> . Sexpr) ..)."
- (COND ((REFVECP X)
- (do ((i 0 (1+ i))
- (k (maxindex x)))
- ((> i k))
- (if (LET ((Y (LASSOC (ELT X I) AL))) (SETELT X I Y))
- (TRANSLABEL1 (ELT X I) AL))))
- ((ATOM X) NIL)
- ((LET ((Y (LASSOC (FIRST X) AL)))
- (if Y (setf (FIRST X) Y) (TRANSLABEL1 (CDR X) AL))))
- ((TRANSLABEL1 (FIRST X) AL) (TRANSLABEL1 (CDR X) AL))))
-
-; **** 5. BOOT Error Handling
-
-(defun SPAD_SYNTAX_ERROR (&rest byebye)
- "Print syntax error indication, underline character, scrub line."
- (BUMPERRORCOUNT '|syntax|)
- (COND ((AND (EQ DEBUGMODE 'YES) (NOT(CONSOLEINPUTP IN-STREAM)))
- (SPAD_LONG_ERROR))
- ((SPAD_SHORT_ERROR)))
- (IOClear)
- (throw 'spad_reader nil))
-
-(defun SPAD_LONG_ERROR ()
- (SPAD_ERROR_LOC SPADERRORSTREAM)
- (iostat)
- (unless (EQUAL OUT-STREAM SPADERRORSTREAM)
- (SPAD_ERROR_LOC OUT-STREAM)
- (TERPRI OUT-STREAM)))
-
-(defun SPAD_SHORT_ERROR () (current-line-show))
-
-(defun SPAD_ERROR_LOC (STR)
- (format str "******** Boot Syntax Error detected ********"))
-
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}