diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/ChangeLog | 27 | ||||
| -rw-r--r-- | src/interp/Makefile.in | 32 | ||||
| -rw-r--r-- | src/interp/Makefile.pamphlet | 32 | ||||
| -rw-r--r-- | src/interp/bootlex.lisp | 453 | ||||
| -rw-r--r-- | src/interp/bootlex.lisp.pamphlet | 475 | ||||
| -rw-r--r-- | src/interp/comp.lisp (renamed from src/interp/comp.lisp.pamphlet) | 88 | ||||
| -rw-r--r-- | src/interp/def.lisp (renamed from src/interp/def.lisp.pamphlet) | 60 | ||||
| -rw-r--r-- | src/interp/fname.lisp (renamed from src/interp/fname.lisp.pamphlet) | 22 | ||||
| -rw-r--r-- | src/interp/metalex.lisp (renamed from src/interp/metalex.lisp.pamphlet) | 35 | ||||
| -rw-r--r-- | src/interp/nspadaux.lisp (renamed from src/interp/nspadaux.lisp.pamphlet) | 22 | ||||
| -rw-r--r-- | src/interp/obey.lisp (renamed from src/interp/obey.lisp.pamphlet) | 26 | ||||
| -rw-r--r-- | src/interp/parsing.lisp (renamed from src/interp/parsing.lisp.pamphlet) | 69 | ||||
| -rw-r--r-- | src/interp/postprop.lisp (renamed from src/interp/postprop.lisp.pamphlet) | 22 | ||||
| -rw-r--r-- | src/interp/union.lisp (renamed from src/interp/union.lisp.pamphlet) | 28 |
14 files changed, 586 insertions, 805 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index aa14f885..3e3e8447 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,5 +1,32 @@ 2007-09-09 Gabriel Dos Reis <gdr@cs.tamu.edu> + * 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. + +2007-09-09 Gabriel Dos Reis <gdr@cs.tamu.edu> + * sys-macros.lisp: Add ugly work-around about infamous GCL bug. * vmlisp.lisp.pamphlet: Export WRAP. * Makefile.pamphlet (<<buildom.clisp>>): Remove. diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 70264ba4..7978cb3c 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -31,7 +31,7 @@ depsys_lisp_sources = $(depsys_lisp_noncompiled_sources) \ depsys_boot_sources = postpar.boot parse.boot clam.boot slam.boot \ g-boot.boot g-error.boot c-util.boot g-util.boot DEP= nlib.lisp \ - macros.lisp comp.lisp \ + macros.lisp $(srcdir)/comp.lisp \ spaderror.lisp debug.lisp \ spad.lisp bits.lisp \ setq.lisp property.lisp \ @@ -367,35 +367,35 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ @ echo '(|importModule| "util")' >> makedep.lisp @ echo '(in-package "BOOT")' >> makedep.lisp @ echo '(build-depsys (quote ($(patsubst %, "%", ${DEP}))) "${AXIOM}")' >> makedep.lisp - @ echo '(unless (probe-file "postpar.$(FASLEXT)") (compile-file "postpar.clisp" :output-file "postpar.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "postpar.$(FASLEXT)") (|compileLispFile| "postpar.clisp" "postpar.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "postpar")' >> makedep.lisp - @ echo '(unless (probe-file "parse.$(FASLEXT)") (compile-file "parse.clisp" :output-file "parse.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "parse.$(FASLEXT)") (|compileLispFile| "parse.clisp" "parse.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "parse")' >> makedep.lisp - @ echo '(unless (probe-file "metalex.$(FASLEXT)") (compile-file "metalex.lisp" :output-file "metalex.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "metalex.$(FASLEXT)") (|compileLispFile| "$(srcdir)/metalex.lisp" "metalex.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "metalex")' >> makedep.lisp - @ echo '(unless (probe-file "bootlex.$(FASLEXT)") (compile-file "bootlex.lisp" :output-file "bootlex.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "bootlex.$(FASLEXT)") (|compileLispFile| "$(srcdir)/bootlex.lisp" "bootlex.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "bootlex")' >> makedep.lisp - @ echo '(unless (probe-file "newaux.$(FASLEXT)") (compile-file "newaux.lisp" :output-file "newaux.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "newaux.$(FASLEXT)") (|compileLispFile| "newaux.lisp" "newaux.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "newaux")' >> makedep.lisp - @ echo '(unless (probe-file "preparse.$(FASLEXT)") (compile-file "preparse.lisp" :output-file "preparse.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "preparse.$(FASLEXT)") (|compileLispFile| "preparse.lisp" "preparse.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "preparse")' >> makedep.lisp - @ echo '(unless (probe-file "postprop.$(FASLEXT)") (compile-file "postprop.lisp" :output-file "postprop.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "postprop.$(FASLEXT)") (|compileLispFile| "$(srcdir)/postprop.lisp" "postprop.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "postprop")' >> makedep.lisp - @ echo '(unless (probe-file "def.$(FASLEXT)") (compile-file "def.lisp" :output-file "def.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "def.$(FASLEXT)") (|compileLispFile| "$(srcdir)/def.lisp" "def.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "def")' >> makedep.lisp - @ echo '(unless (probe-file "fnewmeta.$(FASLEXT)") (compile-file "fnewmeta.lisp" :output-file "fnewmeta.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "fnewmeta.$(FASLEXT)") (|compileLispFile| "fnewmeta.lisp" "fnewmeta.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "fnewmeta")' >> makedep.lisp - @ echo '(unless (probe-file "clam.$(FASLEXT)") (compile-file "clam.clisp" :output-file "clam.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "clam.$(FASLEXT)") (|compileLispFile| "clam.clisp" "clam.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "clam")' >> makedep.lisp - @ echo '(unless (probe-file "slam.$(FASLEXT)") (compile-file "slam.clisp" :output-file "slam.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "slam.$(FASLEXT)") (|compileLispFile| "slam.clisp" "slam.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "slam")' >> makedep.lisp - @ echo '(unless (probe-file "g-error.$(FASLEXT)") (compile-file "g-error.clisp" :output-file "g-error.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "g-error.$(FASLEXT)") (|compileLispFile| "g-error.clisp" "g-error.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "g-error")' >> makedep.lisp - @ echo '(unless (probe-file "g-boot.$(FASLEXT)") (compile-file "g-boot.clisp" :output-file "g-boot.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "g-boot.$(FASLEXT)") (|compileLispFile| "g-boot.clisp" "g-boot.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "g-boot")' >> makedep.lisp - @ echo '(unless (probe-file "c-util.$(FASLEXT)") (compile-file "c-util.${LISP}" :output-file "c-util.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "c-util.$(FASLEXT)") (|compileLispFile| "c-util.${LISP}" "c-util.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "c-util")' >> makedep.lisp - @ echo '(unless (probe-file "g-util.$(FASLEXT)") (compile-file "g-util.clisp" :output-file "g-util.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "g-util.$(FASLEXT)") (|compileLispFile| "g-util.clisp" "g-util.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "g-util")' >> makedep.lisp ../lisp/base-lisp$(EXEEXT) -- --make --output=$@ \ --load-directory=. makedep.lisp diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 5327c953..583bb05d 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -269,7 +269,7 @@ expanded in later compiles. All macros are assumed to be in this list of files. <<environment>>= DEP= nlib.lisp \ - macros.lisp comp.lisp \ + macros.lisp $(srcdir)/comp.lisp \ spaderror.lisp debug.lisp \ spad.lisp bits.lisp \ setq.lisp property.lisp \ @@ -1000,35 +1000,35 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ @ echo '(|importModule| "util")' >> makedep.lisp @ echo '(in-package "BOOT")' >> makedep.lisp @ echo '(build-depsys (quote ($(patsubst %, "%", ${DEP}))) "${AXIOM}")' >> makedep.lisp - @ echo '(unless (probe-file "postpar.$(FASLEXT)") (compile-file "postpar.clisp" :output-file "postpar.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "postpar.$(FASLEXT)") (|compileLispFile| "postpar.clisp" "postpar.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "postpar")' >> makedep.lisp - @ echo '(unless (probe-file "parse.$(FASLEXT)") (compile-file "parse.clisp" :output-file "parse.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "parse.$(FASLEXT)") (|compileLispFile| "parse.clisp" "parse.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "parse")' >> makedep.lisp - @ echo '(unless (probe-file "metalex.$(FASLEXT)") (compile-file "metalex.lisp" :output-file "metalex.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "metalex.$(FASLEXT)") (|compileLispFile| "$(srcdir)/metalex.lisp" "metalex.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "metalex")' >> makedep.lisp - @ echo '(unless (probe-file "bootlex.$(FASLEXT)") (compile-file "bootlex.lisp" :output-file "bootlex.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "bootlex.$(FASLEXT)") (|compileLispFile| "$(srcdir)/bootlex.lisp" "bootlex.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "bootlex")' >> makedep.lisp - @ echo '(unless (probe-file "newaux.$(FASLEXT)") (compile-file "newaux.lisp" :output-file "newaux.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "newaux.$(FASLEXT)") (|compileLispFile| "newaux.lisp" "newaux.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "newaux")' >> makedep.lisp - @ echo '(unless (probe-file "preparse.$(FASLEXT)") (compile-file "preparse.lisp" :output-file "preparse.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "preparse.$(FASLEXT)") (|compileLispFile| "preparse.lisp" "preparse.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "preparse")' >> makedep.lisp - @ echo '(unless (probe-file "postprop.$(FASLEXT)") (compile-file "postprop.lisp" :output-file "postprop.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "postprop.$(FASLEXT)") (|compileLispFile| "$(srcdir)/postprop.lisp" "postprop.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "postprop")' >> makedep.lisp - @ echo '(unless (probe-file "def.$(FASLEXT)") (compile-file "def.lisp" :output-file "def.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "def.$(FASLEXT)") (|compileLispFile| "$(srcdir)/def.lisp" "def.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "def")' >> makedep.lisp - @ echo '(unless (probe-file "fnewmeta.$(FASLEXT)") (compile-file "fnewmeta.lisp" :output-file "fnewmeta.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "fnewmeta.$(FASLEXT)") (|compileLispFile| "fnewmeta.lisp" "fnewmeta.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "fnewmeta")' >> makedep.lisp - @ echo '(unless (probe-file "clam.$(FASLEXT)") (compile-file "clam.clisp" :output-file "clam.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "clam.$(FASLEXT)") (|compileLispFile| "clam.clisp" "clam.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "clam")' >> makedep.lisp - @ echo '(unless (probe-file "slam.$(FASLEXT)") (compile-file "slam.clisp" :output-file "slam.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "slam.$(FASLEXT)") (|compileLispFile| "slam.clisp" "slam.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "slam")' >> makedep.lisp - @ echo '(unless (probe-file "g-error.$(FASLEXT)") (compile-file "g-error.clisp" :output-file "g-error.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "g-error.$(FASLEXT)") (|compileLispFile| "g-error.clisp" "g-error.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "g-error")' >> makedep.lisp - @ echo '(unless (probe-file "g-boot.$(FASLEXT)") (compile-file "g-boot.clisp" :output-file "g-boot.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "g-boot.$(FASLEXT)") (|compileLispFile| "g-boot.clisp" "g-boot.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "g-boot")' >> makedep.lisp - @ echo '(unless (probe-file "c-util.$(FASLEXT)") (compile-file "c-util.${LISP}" :output-file "c-util.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "c-util.$(FASLEXT)") (|compileLispFile| "c-util.${LISP}" "c-util.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "c-util")' >> makedep.lisp - @ echo '(unless (probe-file "g-util.$(FASLEXT)") (compile-file "g-util.clisp" :output-file "g-util.$(FASLEXT)"))' >> makedep.lisp + @ echo '(unless (probe-file "g-util.$(FASLEXT)") (|compileLispFile| "g-util.clisp" "g-util.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "g-util")' >> makedep.lisp <<save depsys image>> @rm $(addsuffix .$(FASLEXT), \ diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp new file mode 100644 index 00000000..11253558 --- /dev/null +++ b/src/interp/bootlex.lisp @@ -0,0 +1,453 @@ +;; 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. + + +; 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 ********")) + 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} diff --git a/src/interp/comp.lisp.pamphlet b/src/interp/comp.lisp index d140c62e..f46dc474 100644 --- a/src/interp/comp.lisp.pamphlet +++ b/src/interp/comp.lisp @@ -1,22 +1,3 @@ -%% Oh Emacs, this is a -*- Lisp -*- file despite apperance. -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/comp.lisp} Pamphlet} -\author{Timothy Daly} - -\begin{document} -\maketitle - -\begin{abstract} -\end{abstract} - -\tableofcontents -\eject - -\section{License} - -<<license>>= ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. ;; @@ -48,9 +29,6 @@ ;; 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: Compiler Utilities Package @@ -100,22 +78,22 @@ (defun |compQuietly| (fn) (let ((*comp370-apply* - (if |$InteractiveMode| - (if |$compileDontDefineFunctions| #'compile-defun #'eval-defun) - #'print-defun)) + (if |$InteractiveMode| + (if |$compileDontDefineFunctions| #'compile-defun #'eval-defun) + #'print-defun)) ;; following creates a null outputstream if $InteractiveMode - (*standard-output* - (if |$InteractiveMode| (make-broadcast-stream) - *standard-output*))) + (*standard-output* + (if |$InteractiveMode| (make-broadcast-stream) + *standard-output*))) (COMP fn))) #-:CCL (defun |compileFileQuietly| (fn) (let ( ;; following creates a null outputstream if $InteractiveMode - (*standard-output* - (if |$InteractiveMode| (make-broadcast-stream) - *standard-output*))) + (*standard-output* + (if |$InteractiveMode| (make-broadcast-stream) + *standard-output*))) (COMPILE-FILE fn))) #+:CCL @@ -168,26 +146,26 @@ (defun |compileQuietly| (fn) (let ((*comp370-apply* - (if |$InteractiveMode| - (if |$compileDontDefineFunctions| #'compile-defun #'eval-defun) - #'print-defun)) + (if |$InteractiveMode| + (if |$compileDontDefineFunctions| #'compile-defun #'eval-defun) + #'print-defun)) ;; following creates a null outputstream if $InteractiveMode - (*standard-output* - (if |$InteractiveMode| (make-broadcast-stream) - *standard-output*))) + (*standard-output* + (if |$InteractiveMode| (make-broadcast-stream) + *standard-output*))) (COMP370 fn))) (defun COMP-1 (X) (let* ((FNAME (car X)) - ($FUNNAME FNAME) + ($FUNNAME FNAME) ($FUNNAME_TAIL (LIST FNAME)) - (LAMEX (second X)) - ($closedfns nil)) + (LAMEX (second X)) + ($closedfns nil)) (declare (special $FUNNAME $FUNNAME_TAIL $CLOSEDFNS)) (setq LAMEX (COMP-TRAN LAMEX)) (COMP-NEWNAM LAMEX) (if (fboundp FNAME) - (format t "~&~%;;; *** ~S REDEFINED~%" FNAME)) + (format t "~&~%;;; *** ~S REDEFINED~%" FNAME)) (CONS (LIST FNAME LAMEX) $CLOSEDFNS))) (defun Comp-2 (args &aux name type argl bodyl junk) @@ -287,11 +265,11 @@ ((ATOM (setq Y (CAR X))) ;; (AND (IDENTP Y) (setq U (GET Y 'NEWNAM)) (RPLACA X U)) (AND (NOT (eq Y 'QUOTE)) (COMP-NEWNAM (CDR X))) - (WHEN (and (EQ Y 'CLOSEDFN) (boundp '$closedfns)) - (SETQ U (MAKE-CLOSEDFN-NAME)) - (PUSH (list U (CADR X)) $closedfns) - (rplaca x 'FUNCTION) - (rplaca (cdr x) u))) + (WHEN (and (EQ Y 'CLOSEDFN) (boundp '$closedfns)) + (SETQ U (MAKE-CLOSEDFN-NAME)) + (PUSH (list U (CADR X)) $closedfns) + (rplaca x 'FUNCTION) + (rplaca (cdr x) u))) (t (COMP-NEWNAM (CAR X)) (COMP-NEWNAM (CDR X)))))) (defun make-closedfn-name () @@ -305,7 +283,7 @@ (if (and (null (cdddr x)) (or (atom (third x)) (eq (car (third x)) 'SEQ) - (not (contained 'EXIT (third x))))) + (not (contained 'EXIT (third x))))) (caddr x) (cons 'SEQ (cddr x))))) ;catch naked EXITs (let* ((FluidVars (REMDUP (NREVERSE FLUIDVARS))) @@ -319,9 +297,9 @@ (prog ,lvars (declare (special . ,fluids)) (return ,(third x)))) (list (first x) (second x) - (if (or lvars (contained 'RETURN (third x))) - `(prog ,lvars (return ,(third x))) - (third x)) ))))) + (if (or lvars (contained 'RETURN (third x))) + `(prog ,lvars (return ,(third x))) + (third x)) ))))) (let ((fluids (S+ (comp-fluidize (second x)) SpecialVars))) (if fluids `(,(first x) ,(second x) (declare (special . ,fluids)) . ,(cddr x)) @@ -332,7 +310,7 @@ (DEFUN COMP-FLUIDIZE (X) (COND ((AND (symbolp X) (NE X '$) - (NE X '$$) + (NE X '$$) (char= #\$ (ELT (PNAME X) 0)) (NOT (DIGITP (ELT (PNAME X) 1)))) x) @@ -362,7 +340,7 @@ (defparameter $COMP-MACROLIST '(COLLECT REPEAT SUCHTHATCLAUSE THETA COLLECTV COLLECTVEC - THETA1 SPADREDUCE SPADDO) + THETA1 SPADREDUCE SPADDO) "???") (DEFUN COMP-EXPAND (X) @@ -429,9 +407,3 @@ (defmacro RELET (L) `(spadlet . ,L)) (defmacro PRESET (L) `(spadlet . ,L)) (defmacro RESET (L) `(spadlet . ,L)) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/def.lisp.pamphlet b/src/interp/def.lisp index de62641d..4a70afcd 100644 --- a/src/interp/def.lisp.pamphlet +++ b/src/interp/def.lisp @@ -1,20 +1,3 @@ -%% Oh Emacs, this is a -*- Lisp -*- file, despite appearance. -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/def.lisp} Pamphlet} -\author{Timothy Daly} - -\begin{document} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject - -\section{License} -<<license>>= ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. ;; @@ -46,9 +29,6 @@ ;; 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: Def ; PURPOSE: Defines BOOT code @@ -80,7 +60,7 @@ foo defined inside of fum gets renamed as fum,foo.") ($body (deftran $body)) (argl (DEF-INSERT_LET argl)) (arglp (DEF-STRINGTOQUOTE argl)) - ($body (|bootTransform| $body))) + ($body (|bootTransform| $body))) (COMP (SUBLIS $OPASSOC (list (list $OP (list 'LAM arglp $body))))))) ; We are making shallow binding cells for these functions as well @@ -102,14 +82,14 @@ foo defined inside of fum gets renamed as fum,foo.") ((NOT (SECOND X)) (LIST 'NULL (FIRST X))) ; ((AND (EQCAR (SECOND X) 'QUOTE) (IDENTP (CADADR X))) (CONS 'EQ X)) ($BOOT (CONS 'BOOT-EQUAL X)) - ((CONS 'EQUAL X)))) + ((CONS 'EQUAL X)))) (defun DEF-LESSP (x) (cond ((null (cdr x)) (cons '< x)) - ((eq (cadr x) 0) (list 'minusp (car x))) - ((and (smint-able (car x)) (smint-able (cadr x))) - (cons 'qslessp x)) - ('t (list '> (CADR x) (CAR x))))) + ((eq (cadr x) 0) (list 'minusp (car x))) + ((and (smint-able (car x)) (smint-able (cadr x))) + (cons 'qslessp x)) + ('t (list '> (CADR x) (CAR x))))) (defun smint-able (x) (or (smintp x) @@ -125,8 +105,8 @@ foo defined inside of fum gets renamed as fum,foo.") (car (setq Y (cdr Y))) (car (setq Y (cdr Y))) (CONS 'WHERE (cons (car (setq Y (cdr Y))) (cddr X))))))) - ((IS-CONSOLE *STANDARD-OUTPUT*) - (SAY " VALUE = " (EVAL (DEFTRAN X)))) + ((IS-CONSOLE *STANDARD-OUTPUT*) + (SAY " VALUE = " (EVAL (DEFTRAN X)))) ((print-full (DEFTRAN X))))) (defun B-MDEF (FORM SIGNATURE $BODY) @@ -176,8 +156,8 @@ foo defined inside of fum gets renamed as fum,foo.") (if (STRINGP X) `(QUOTE ,(intern x)) X) (let ((g (gensym))) (setq $body (mkprogn - (list (def-let (comp\,fluidize x) g) - $body))) + (list (def-let (comp\,fluidize x) g) + $body))) g))) (mapcar #'(lambda (x) (MAKEPROP (CAR X) 'RENAME (CDR X))) @@ -187,7 +167,7 @@ foo defined inside of fum gets renamed as fum,foo.") (|setDifference| SETDIFFERENCE) (INTERSECTION |intersection|) (|setIntersection| |intersection|) (|setUnion| |union|) (UNION |union|) (REMOVE |remove|) (MEMBER |member|) (ASSOC |assoc|) - (READ VMREAD) (READ-LINE |read-line|) + (READ VMREAD) (READ-LINE |read-line|) (|apply| APPLY) (|lastNode| LASTPAIR) (LAST |last|) (|in| |member|) (|strconc| STRCONC) (|append| APPEND) (|copy| COPY) (DELETE |delete|) (RASSOC |rassoc|) @@ -257,9 +237,9 @@ foo defined inside of fum gets renamed as fum,foo.") (defun |DEF-:| (X &aux Y) (DCQ (x y) x) `(SPADLET ,(if (or (eq y '|fluid|) - (and (identp x) (char= #\$ (ELT (PNAME X) 0)))) - `(FLUID ,X) X) - NIL)) + (and (identp x) (char= #\$ (ELT (PNAME X) 0)))) + `(FLUID ,X) X) + NIL)) (defmacro |DEF-::| (X) (let ((expr (first x)) (type (second x))) @@ -336,8 +316,8 @@ foo defined inside of fum gets renamed as fum,foo.") (COND ((THIRD U) (LIST 'STEP (SECOND X) (SECOND U) 1 (THIRD U))) ((LIST 'STEP (SECOND X) (SECOND U) 1)) )) - ((AND (EQCAR X 'INBY) (EQCAR (setq U (THIRD X)) 'SEGMENT)) - (COND + ((AND (EQCAR X 'INBY) (EQCAR (setq U (THIRD X)) 'SEGMENT)) + (COND ((THIRD U) (LIST 'STEP (SECOND X) (SECOND U) (|last| x) (THIRD U))) ((LIST 'STEP (SECOND X) (SECOND U) (|last| x))) )) (X)))) @@ -360,7 +340,7 @@ foo defined inside of fum gets renamed as fum,foo.") (DEFTRAN (LIST 'SETELT (CADR FORM) (CADDR FORM) RHS)) ))) (RETURN (COND (|$useDCQnotLET| (|defLETdcq| FORM (DEFTRAN RHS))) - ('T (|defLET| FORM (DEFTRAN RHS))))))) + ('T (|defLET| FORM (DEFTRAN RHS))))))) (defun |defLETdcq| (FORM RHS &AUX G NAME) ;; see defLET in G-BOOT BOOT @@ -664,9 +644,3 @@ except that elements are separated by commas." (defun |newConstruct| (l) (if (ATOM l) l `(CONS ,(CAR l) ,(|newConstruct| (CDR l))))) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/fname.lisp.pamphlet b/src/interp/fname.lisp index 0a6ccc04..1d54a0d9 100644 --- a/src/interp/fname.lisp.pamphlet +++ b/src/interp/fname.lisp @@ -1,16 +1,3 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp fname.lisp} -\author{Stephen M. Watt, 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. ;; @@ -42,9 +29,6 @@ ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> ;; ;; Lisp support for cleaned up FileName domain. @@ -114,9 +98,3 @@ (setq fn (|fnameMake| d (string (gensym n)) e)) (if (not (probe-file (namestring fn))) (return-from |fnameNew| fn)) ))) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/metalex.lisp.pamphlet b/src/interp/metalex.lisp index 32fa639e..f718ba1d 100644 --- a/src/interp/metalex.lisp.pamphlet +++ b/src/interp/metalex.lisp @@ -1,21 +1,3 @@ -%% Oh Emacs, this is a -*- Lisp -*- file, despite appearance. -\documentclass{article} -\usepackage{axiom} - -\title{\$SPAD/src/interp metalex.lisp} -\author{Timothy Daly} - -\begin{document} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject - -\section{License} - -<<license>>= ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. ;; @@ -47,9 +29,6 @@ ;; 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: MetaLex.lisp ; PURPOSE: Parsing support routines for Meta code @@ -75,7 +54,7 @@ if it gets a non-blank line, and NIL at end of stream." (prog (string) empty (if File-Closed (return nil)) (setq string (kill-trailing-blanks (kill-comments - (get-a-line in-stream)))) + (get-a-line in-stream)))) (if (= (length string) 0) (go empty)) (Line-New-Line (suffix #\Space string) Current-Line) (if Echo-Meta (Print-New-Line (Line-Buffer Current-Line) out-stream)) @@ -246,10 +225,10 @@ special character be the atom whose print name is the character itself." (go nu1)))) (advance-char) formint(return (token-install - (read-from-string buf) + (read-from-string buf) 'number token - (size buf) ;used to keep track of digit count - )))) + (size buf) ;used to keep track of digit count + )))) ; *** 4. META Auxiliary Parsing Actions @@ -294,9 +273,3 @@ special character be the atom whose print name is the character itself." (incf $num_of_meta_errors) (setq Meta_Errors_Occurred t))) nil) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nspadaux.lisp.pamphlet b/src/interp/nspadaux.lisp index 1b272228..299b5240 100644 --- a/src/interp/nspadaux.lisp.pamphlet +++ b/src/interp/nspadaux.lisp @@ -1,16 +1,3 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nspadaux.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. ;; @@ -42,9 +29,6 @@ ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> (in-package "BOOT") @@ -131,9 +115,3 @@ (remprop 'cons 'format) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/obey.lisp.pamphlet b/src/interp/obey.lisp index 486e08f6..6e105f2b 100644 --- a/src/interp/obey.lisp.pamphlet +++ b/src/interp/obey.lisp @@ -1,16 +1,3 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp obey.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. ;; @@ -42,16 +29,13 @@ ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> (in-package "VMLISP") #+ (and :lucid :unix) (defun OBEY (S) (system:run-aix-program (make-absolute-filename "/lib/obey") - :arguments (list "-c" S))) + :arguments (list "-c" S))) #+ (and :lucid :unix) (defun makedir (fname) @@ -69,7 +53,7 @@ (defun copy-lib-directory (name1 name2) (vmlisp::makedir name2) (system:run-aix-program "sh" :arguments - (list "-c" (concat "cp " name1 "/* " name2)))) + (list "-c" (concat "cp " name1 "/* " name2)))) #+ (and :lucid :unix) (defun copy-file (namestring1 namestring2) @@ -78,9 +62,3 @@ (setq |$algebraOutputStream| *terminal-io*) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp index 7301b8fe..d3d8dbc2 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp @@ -1,21 +1,3 @@ -%% Oh Emacs, this is a -*- Lisp -*- file, despite appearance. -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/parsing.lisp} Pamphlet} -\author{Timothy Daly} - -\begin{document} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject - -\section{License} - -<<license>>= ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. ;; @@ -47,9 +29,6 @@ ;; 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: META/LISP Parser Generator and Lexical Analysis Utilities (Parsing) ; @@ -545,17 +524,17 @@ the stack, then stack a NIL. Return the value of prod." (string (strconc "'" (token-symbol token) "'")) (spadstring (strconc "\"" (underscore (token-symbol token)) "\"")) (number (format nil "~v,'0D" (token-nonblank token) - (token-symbol token))) + (token-symbol token))) (special-char (string (token-symbol token))) (identifier (let ((id (symbol-name (token-symbol token))) - (pack (package-name (symbol-package - (token-symbol token))))) + (pack (package-name (symbol-package + (token-symbol token))))) (if (or $BOOT $SPAD) - (if (equal pack "BOOT") - (escape-keywords (underscore id) (token-symbol token)) - (concatenate 'string - (underscore pack) "'" (underscore id))) - id))) + (if (equal pack "BOOT") + (escape-keywords (underscore id) (token-symbol token)) + (concatenate 'string + (underscore pack) "'" (underscore id))) + id))) (t (token-symbol token))) nil)) @@ -567,15 +546,15 @@ the stack, then stack a NIL. Return the value of prod." (defun underscore (string) (if (every #'alpha-char-p string) string (let* ((size (length string)) - (out-string (make-array (* 2 size) - :element-type 'character - :fill-pointer 0)) - next-char) + (out-string (make-array (* 2 size) + :element-type 'character + :fill-pointer 0)) + next-char) (dotimes (i size) - (setq next-char (char string i)) - (if (not (alpha-char-p next-char)) - (vector-push #\_ out-string)) - (vector-push next-char out-string)) + (setq next-char (char string i)) + (if (not (alpha-char-p next-char)) + (vector-push #\_ out-string)) + (vector-push next-char out-string)) out-string))) (defun Unget-Tokens () @@ -642,7 +621,7 @@ the stack, then stack a NIL. Return the value of prod." (try-get-token Next-Token))) (defun advance-token () - (current-token) ;don't know why this is needed + (current-token) ;don't know why this is needed "Makes the next token be the current token." (case Valid-Tokens (0 (try-get-token (Current-Token))) @@ -1009,11 +988,11 @@ Symbolics read-line returns embedded newlines in a c-m-Y.") (embed x (cond ((eqcar y 'lambda) y) ((eqcar y 'before) - `(lambda ,(cadr y) - (prog2 ,(caddr y) ,(cons 'funcall (cons x (cadr y)))))) + `(lambda ,(cadr y) + (prog2 ,(caddr y) ,(cons 'funcall (cons x (cadr y)))))) ((eqcar y 'after) - `(lambda ,(cadr y) - (prog1 ,(cons 'funcall (cons x (cadr y))) ,(caddr y)))))) + `(lambda ,(cadr y) + (prog1 ,(cons 'funcall (cons x (cadr y))) ,(caddr y)))))) (/embedreply)) (defun /embedreply () @@ -1087,9 +1066,3 @@ Symbolics read-line returns embedded newlines in a c-m-Y.") (if (and (not (atom rand)) (cdr rand)) (cons (list eltWord dom (car rand)) (cdr rand)) (list eltWord dom rand)))) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/postprop.lisp.pamphlet b/src/interp/postprop.lisp index 0f3876d1..921c58c3 100644 --- a/src/interp/postprop.lisp.pamphlet +++ b/src/interp/postprop.lisp @@ -1,16 +1,3 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp postprop.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. ;; @@ -42,9 +29,6 @@ ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> (in-package "BOOT") @@ -144,9 +128,3 @@ (VCONS |parseVCONS|) (|where| |parseWhere|) (|xor| |parseExclusiveOr|))) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/union.lisp.pamphlet b/src/interp/union.lisp index ea734b48..2c82e06f 100644 --- a/src/interp/union.lisp.pamphlet +++ b/src/interp/union.lisp @@ -1,22 +1,3 @@ -%% Oh Emacs, this is a -*- Lisp -*- file despite apperance. -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/union.lisp} Pamphlet} -\author{Timothy Daly} - -\begin{document} -\maketitle - -\begin{abstract} -\end{abstract} - -\tableofcontents -\eject - -\section{License} - -<<license>>= ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. ;; @@ -48,9 +29,6 @@ ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> (IMPORT-MODULE "vmlisp") (in-package "VMLISP") @@ -177,9 +155,3 @@ ( (NOT (QMEMQ I LIST-OF-ITEMS-2)) (QRPLACD V (SETQ V (CONS I NIL))) ) ) (GO LP1) ) ) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} |