diff options
| -rw-r--r-- | src/interp/ChangeLog | 50 | ||||
| -rw-r--r-- | src/interp/Makefile.in | 18 | ||||
| -rw-r--r-- | src/interp/Makefile.pamphlet | 27 | ||||
| -rw-r--r-- | src/interp/bootlex.lisp.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/debug.lisp.pamphlet | 1 | ||||
| -rw-r--r-- | src/interp/metalex.lisp.pamphlet | 32 | ||||
| -rw-r--r-- | src/interp/metameta.lisp.pamphlet | 384 | ||||
| -rw-r--r-- | src/interp/spad.lisp.pamphlet | 170 |
8 files changed, 60 insertions, 624 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index 9b283ad5..0a58efa3 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,3 +1,53 @@ +2007-08-18 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * bootlex.lisp.pamphlet (|boot-LEXPR|): Remove + + * spad.lisp.pamphlet (BOOT-LEXPR): Remove. + (NBOOT-LEXPR): Likewise. + (New-LEXPR): Likewise. + (New-LEXPR1): Likewise. + (New-LEXPR-Interactive): Likewise. + (|getTranslation|): Likewise. + (|New-LEXPR|): Likewise. + (|boot2Lisp|): Likewise. + (|boot2LispError|): Likewise. + (|New,ENTRY|): Likewise. + (new): Likewise. + (newpo): Likewise. + (|New,ENTRY,SYS|): Likewise. + (|New,ENTRY1|): Likewise. + (/cx): Likewise. + (/foobar): Likewise. + (|/cxd|): Likewise. + (|/rx|): Likewise. + (|/ry|): Likewise. + (|/tb|): Likewise. + (|$lisp2lispRenameAssoc|): Likewise.. + (|$spadOpList|): Likewise. + (SPAD-MDTR-1): Likewise. + (SPAD-MDTR-2): Likewise. + (foobar): Likewise. + + * metalex.lisp.pamphlet (in-meta): Remove. + (newrule): Likewise. + (meta): Likrwise. + + * spad.lisp.pamphlet (/TRANSMETA): Remove. + (/TRANSBOOT): Likewise. + (/TRANSNBOOT): Likewise. + + * debug.lisp.pamphlet (META): Don't set property. + + * Makefile.pamphlet (depsys_lisp_compiled_sources): Don't include + metameta.lisp + (OPOBJS): Likewise. + (depsys_lisp_sources): Likewise. + (depsys_objects): Likewise. + (${DEPSYS}): Don't depend on it. Don't load it. + (${AUTO}/metameta.$(FASLEXT)): Remove. + + * metameta.lisp.pamphlet: Remove. + 2007-08-19 Gabriel Dos Reis <gdr@cs.tamu.edu> * msg.boot.pamphlet (putDatabaseStuff): Fix thinko. diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index fff90a19..d5e19916 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -22,7 +22,7 @@ BOOTSYS= $(axiom_build_bindir)/bootsys DEPSYS = ./depsys depsys_lisp_compiled_sources += parsing.lisp metalex.lisp bootlex.lisp \ - newaux.lisp preparse.lisp postprop.lisp def.lisp metameta.lisp \ + newaux.lisp preparse.lisp postprop.lisp def.lisp \ fnewmeta.lisp depsys_lisp_sources = $(depsys_lisp_noncompiled_sources) \ @@ -149,7 +149,6 @@ IN_modules = $(patsubst %.$(FASLEXT), "%", $(INOBJS)) OPOBJS= ${AUTO}/parsing.$(FASLEXT) ${AUTO}/bootlex.$(FASLEXT) \ ${AUTO}/def.$(FASLEXT) \ ${AUTO}/fnewmeta.$(FASLEXT) ${AUTO}/metalex.$(FASLEXT) \ - ${AUTO}/metameta.$(FASLEXT) \ ${AUTO}/parse.$(FASLEXT) ${AUTO}/postpar.$(FASLEXT) \ ${AUTO}/postprop.$(FASLEXT) ${AUTO}/preparse.$(FASLEXT) @@ -322,7 +321,7 @@ ${SAVESYS}: makeint.lisp $(mkinstalldirs) $(axiom_target_bindir) depsys_lisp_sources += parsing.lisp metalex.lisp bootlex.lisp \ newaux.lisp preparse.lisp postprop.lisp \ - metameta.lisp fnewmeta.lisp + fnewmeta.lisp depsys_boot_sources = postpar.boot parse.boot clam.boot slam.boot \ g-boot.boot g-error.boot c-util.boot g-util.boot @@ -333,7 +332,7 @@ depsys_objects = nocompil.$(FASLEXT) bookvol5.$(FASLEXT) g-error.$(FASLEXT) \ util.$(FASLEXT) postpar.$(FASLEXT) parse.$(FASLEXT) \ parsing.$(FASLEXT) metalex.$(FASLEXT) bootlex.$(FASLEXT) \ newaux.$(FASLEXT) preparse.$(FASLEXT) postprop.$(FASLEXT) \ - metameta.$(FASLEXT) fnewmeta.$(FASLEXT) clam.$(FASLEXT) \ + fnewmeta.$(FASLEXT) clam.$(FASLEXT) \ slam.$(FASLEXT) g-boot.$(FASLEXT) c-util.$(FASLEXT) \ g-util.$(FASLEXT) @@ -351,7 +350,7 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ bootlex.lisp newaux.lisp \ preparse.lisp \ postprop.lisp def.lisp \ - metameta.lisp fnewmeta.lisp \ + fnewmeta.lisp \ g-error.clisp \ g-boot.clisp c-util.${LISP} \ g-util.clisp \ @@ -387,8 +386,6 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ @ echo '(load "postprop")' >> makedep.lisp @ echo '(unless (probe-file "def.$(FASLEXT)") (compile-file "def.lisp" :output-file "def.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "def")' >> makedep.lisp - @ echo '(unless (probe-file "metameta.$(FASLEXT)") (compile-file "metameta.lisp" :output-file "metameta.$(FASLEXT)"))' >> makedep.lisp - @ echo '(load "metameta")' >> makedep.lisp @ echo '(unless (probe-file "fnewmeta.$(FASLEXT)") (compile-file "fnewmeta.lisp" :output-file "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 @@ -407,7 +404,7 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ --load-directory=. makedep.lisp @rm $(addsuffix .$(FASLEXT), \ postpar parse metalex bootlex newaux preparse \ - postprop def metameta fnewmeta clam slam g-error \ + postprop def fnewmeta clam slam g-error \ g-boot c-util g-util) @ echo 4 ${DEPSYS} created @@ -830,11 +827,6 @@ ${AUTO}/metalex.$(FASLEXT): metalex.$(FASLEXT) @ cp metalex.$(FASLEXT) ${AUTO} -${AUTO}/metameta.$(FASLEXT): metameta.$(FASLEXT) - @ echo 71 making ${AUTO}/metameta.$(FASLEXT) from metameta.$(FASLEXT) - @ cp metameta.$(FASLEXT) ${AUTO} - - ${AUTO}/modemap.$(FASLEXT): modemap.$(FASLEXT) @ echo 341 making ${AUTO}/modemap.$(FASLEXT) from modemap.$(FASLEXT) @ cp modemap.$(FASLEXT) ${AUTO} diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index ff5d7ef7..1785de68 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -231,8 +231,6 @@ The [[depsys]] image is made of the following Lisp source files \item[\File{def.lisp}] - \item[\File{metameta.lisp}] - \item[\File{fnewmeta.lisp}] \end{description} @@ -258,7 +256,7 @@ The [[depsys]] image is made of the following Lisp source files % <<environment>>= depsys_lisp_compiled_sources += parsing.lisp metalex.lisp bootlex.lisp \ - newaux.lisp preparse.lisp postprop.lisp def.lisp metameta.lisp \ + newaux.lisp preparse.lisp postprop.lisp def.lisp \ fnewmeta.lisp depsys_lisp_sources = $(depsys_lisp_noncompiled_sources) \ @@ -479,7 +477,6 @@ rethinking. OPOBJS= ${AUTO}/parsing.$(FASLEXT) ${AUTO}/bootlex.$(FASLEXT) \ ${AUTO}/def.$(FASLEXT) \ ${AUTO}/fnewmeta.$(FASLEXT) ${AUTO}/metalex.$(FASLEXT) \ - ${AUTO}/metameta.$(FASLEXT) \ ${AUTO}/parse.$(FASLEXT) ${AUTO}/postpar.$(FASLEXT) \ ${AUTO}/postprop.$(FASLEXT) ${AUTO}/preparse.$(FASLEXT) @@ -972,7 +969,7 @@ of the form: <<depsys>>= depsys_lisp_sources += parsing.lisp metalex.lisp bootlex.lisp \ newaux.lisp preparse.lisp postprop.lisp \ - metameta.lisp fnewmeta.lisp + fnewmeta.lisp depsys_boot_sources = postpar.boot parse.boot clam.boot slam.boot \ g-boot.boot g-error.boot c-util.boot g-util.boot @@ -983,7 +980,7 @@ depsys_objects = nocompil.$(FASLEXT) bookvol5.$(FASLEXT) g-error.$(FASLEXT) \ util.$(FASLEXT) postpar.$(FASLEXT) parse.$(FASLEXT) \ parsing.$(FASLEXT) metalex.$(FASLEXT) bootlex.$(FASLEXT) \ newaux.$(FASLEXT) preparse.$(FASLEXT) postprop.$(FASLEXT) \ - metameta.$(FASLEXT) fnewmeta.$(FASLEXT) clam.$(FASLEXT) \ + fnewmeta.$(FASLEXT) clam.$(FASLEXT) \ slam.$(FASLEXT) g-boot.$(FASLEXT) c-util.$(FASLEXT) \ g-util.$(FASLEXT) @@ -1001,7 +998,7 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ bootlex.lisp newaux.lisp \ preparse.lisp \ postprop.lisp def.lisp \ - metameta.lisp fnewmeta.lisp \ + fnewmeta.lisp \ g-error.clisp \ g-boot.clisp c-util.${LISP} \ g-util.clisp \ @@ -1037,8 +1034,6 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ @ echo '(load "postprop")' >> makedep.lisp @ echo '(unless (probe-file "def.$(FASLEXT)") (compile-file "def.lisp" :output-file "def.$(FASLEXT)"))' >> makedep.lisp @ echo '(load "def")' >> makedep.lisp - @ echo '(unless (probe-file "metameta.$(FASLEXT)") (compile-file "metameta.lisp" :output-file "metameta.$(FASLEXT)"))' >> makedep.lisp - @ echo '(load "metameta")' >> makedep.lisp @ echo '(unless (probe-file "fnewmeta.$(FASLEXT)") (compile-file "fnewmeta.lisp" :output-file "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 @@ -1056,7 +1051,7 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ <<save depsys image>> @rm $(addsuffix .$(FASLEXT), \ postpar parse metalex bootlex newaux preparse \ - postprop def metameta fnewmeta clam slam g-error \ + postprop def fnewmeta clam slam g-error \ g-boot c-util g-util) @ echo 4 ${DEPSYS} created @@ -1262,15 +1257,6 @@ ${AUTO}/metalex.$(FASLEXT): metalex.$(FASLEXT) @ -\subsection{metameta.lisp \cite{23}} - -<<metameta.o (AUTO from OUT)>>= -${AUTO}/metameta.$(FASLEXT): metameta.$(FASLEXT) - @ echo 71 making ${AUTO}/metameta.$(FASLEXT) from metameta.$(FASLEXT) - @ cp metameta.$(FASLEXT) ${AUTO} - -@ - \subsection{nspadaux.lisp \cite{28}} <<nspadaux.o (AUTO from OUT)>>= @@ -2651,8 +2637,6 @@ distclean-local: clean-local <<metalex.o (AUTO from OUT)>> -<<metameta.o (AUTO from OUT)>> - <<modemap.o (AUTO from OUT)>> <<modemap.clisp>> @@ -2790,7 +2774,6 @@ pp \bibitem{20} \File{src/interp/hash.lisp.pamphlet} \bibitem{21} \File{src/interp/macros.lisp.pamphlet} \bibitem{22} \File{src/interp/metalex.lisp.pamphlet} -\bibitem{23} \File{src/interp/metameta.lisp.pamphlet} \bibitem{24} \File{src/interp/monitor.lisp.pamphlet} \bibitem{25} \File{src/interp/newaux.lisp.pamphlet} \bibitem{26} \File{src/interp/nlib.lisp.pamphlet} diff --git a/src/interp/bootlex.lisp.pamphlet b/src/interp/bootlex.lisp.pamphlet index 37ddf16d..925fe24f 100644 --- a/src/interp/bootlex.lisp.pamphlet +++ b/src/interp/bootlex.lisp.pamphlet @@ -429,8 +429,6 @@ or the chracters ?, !, ' or %" (defun-parse-token KEYWORD) (defun-parse-token ARGUMENT-DESIGNATOR) -(defun |boot-LEXPR| () (SETQ $NBOOT T) (New-LEXPR1)) - (defun TRANSLABEL (X AL) (TRANSLABEL1 X AL) X) (defun TRANSLABEL1 (X AL) diff --git a/src/interp/debug.lisp.pamphlet b/src/interp/debug.lisp.pamphlet index 8f73998d..f825845f 100644 --- a/src/interp/debug.lisp.pamphlet +++ b/src/interp/debug.lisp.pamphlet @@ -133,7 +133,6 @@ exit (rds ifile) (MAKEPROP 'BOOT '/XCAPE '#\_) (MAKEPROP 'SPAD '/XCAPE '#\_) (MAKEPROP 'META '/READFUN 'META\,RULE) -(MAKEPROP 'META '/TRAN '/TRANSMETA) (MAKEPROP 'INPUT '/READFUN '|New,LEXPR,Interactive|) (MAKEPROP 'INPUT '/TRAN '/TRANSPAD) (MAKEPROP 'BOOT '/READFUN '|New,LEXPR1|) diff --git a/src/interp/metalex.lisp.pamphlet b/src/interp/metalex.lisp.pamphlet index 1af8f038..d0b6554b 100644 --- a/src/interp/metalex.lisp.pamphlet +++ b/src/interp/metalex.lisp.pamphlet @@ -63,38 +63,6 @@ (in-package "BOOT") -; *** 1. META file handling - -(defun in-meta () - (setq XTokenReader 'get-META-token) - (setq Line-Handler 'next-META-line) - (setq Meta_Error_Handler 'meta-meta-error-handler) - (setq $BOOT nil)) - -(defun newrule () - (in-meta) - (setq meta_prefix "PARSE-") - (test Rule1) - (eval (pop-stack-1)) - (ioclear) - (in-boot)) - -(defun meta (&optional (*meta-input-file* "/spad/meta.meta") - (*meta-output-file* nil)) - (ioclear) - (in-meta) - (with-open-stream - (in-stream (open *meta-input-file* :direction :input)) - (with-open-stream - (out-stream (if *meta-output-file* - (open *meta-output-file* :direction :output) - *terminal-io*)) - (format out-stream - "~&;;; -*- Mode:Lisp; Package:Boot -*-~%~%") - (parse-program) - (IOClear in-stream out-stream))) - T) - ; *** 2. META Line Handling (defun next-META-line (&optional (in-stream t)) diff --git a/src/interp/metameta.lisp.pamphlet b/src/interp/metameta.lisp.pamphlet deleted file mode 100644 index 47070f8d..00000000 --- a/src/interp/metameta.lisp.pamphlet +++ /dev/null @@ -1,384 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp metameta.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>> - -; .META(META PROGRAM) -; .PREFIX 'PARSE-' -; .PACKAGE 'PARSING' -; .DECLARE(METAPGVAR METAVARLST METAKEYLST METARULNAM TRAPFLAG) - -(IN-PACKAGE "BOOT") - -(DEFPARAMETER METAPGVAR NIL) -(DEFPARAMETER METAVARLST NIL) -(DEFPARAMETER METAKEYLST NIL) -(DEFPARAMETER METARULNAM NIL) -(DEFPARAMETER TRAPFLAG NIL) - -; PROGRAM:<HEADER*>! <RULE*>! ='.FIN' ; - -(DEFUN PARSE-PROGRAM NIL - (AND (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-HEADER)))) - (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-RULE)))) - (MATCH-STRING ".FIN"))) - -; HEADER: '.META' '(' IDENTIFIER IDENTIFIER <IDENTIFIER>! ')' .(SETQ XNAME ##3) -; / '.DECLARE' '(' IDENTIFIER* ')' .(PRINT-FLUIDS #1) -; / '.PREFIX' STRING .(SET-PREFIX #1) -; / '.PACKAGE' STRING .(PRINT-PACKAGE #1) ; - -(DEFUN PARSE-HEADER NIL - (OR (AND (MATCH-ADVANCE-STRING ".META") - (MUST (MATCH-ADVANCE-STRING "(")) - (MUST (PARSE-IDENTIFIER)) - (MUST (PARSE-IDENTIFIER)) - (BANG |FIL_TEST| (OPTIONAL (PARSE-IDENTIFIER))) - (MUST (MATCH-ADVANCE-STRING ")")) - (ACTION (SETQ XNAME (NTH-STACK 3)))) - (AND (MATCH-ADVANCE-STRING ".DECLARE") - (MUST (MATCH-ADVANCE-STRING "(")) - (MUST (STAR REPEATOR (PARSE-IDENTIFIER))) - (MUST (MATCH-ADVANCE-STRING ")")) - (ACTION (PRINT-FLUIDS (POP-STACK-1)))) - (AND (MATCH-ADVANCE-STRING ".PREFIX") - (MUST (PARSE-STRING)) - (ACTION (SET-PREFIX (POP-STACK-1)))) - (AND (MATCH-ADVANCE-STRING ".PACKAGE") - (MUST (PARSE-STRING)) - (ACTION (PRINT-PACKAGE (POP-STACK-1)))))) - -; RULE: RULE1 ';' .(PRINT-RULE #1) / ^='.FIN' .(META-SYNTAX-ERROR) ; - -(DEFUN PARSE-RULE NIL - (OR (AND (PARSE-RULE1) - (MUST (MATCH-ADVANCE-STRING ";")) - (ACTION (PRINT-RULE (POP-STACK-1)))) - (AND (NOT (MATCH-STRING ".FIN")) - (ACTION (META-SYNTAX-ERROR))))) - -; RULE1: IDENTIFIER .(SETQ METARULNAM (INTERN (STRCONC META_PREFIX ##1))) -; <'{' FID* '}'>! ':' EXPR =';' -; < =$METAPGVAR +(PROG =(TRANSPGVAR METAPGVAR) (RETURN #1)) -; .(SETQ METAPGVAR NIL) > -; +=(MAKE-DEFUN #3 #2 #1) ; - -(DEFUN PARSE-RULE1 NIL - (AND (PARSE-IDENTIFIER) - (ACTION (SETQ METARULNAM (INTERN (STRCONC |META_PREFIX| (NTH-STACK 1))))) - (BANG |FIL_TEST| - (OPTIONAL (AND (MATCH-ADVANCE-STRING "{") - (MUST (STAR REPEATOR (PARSE-FID))) - (MUST (MATCH-ADVANCE-STRING "}"))))) - (MUST (MATCH-ADVANCE-STRING ":")) - (MUST (PARSE-EXPR)) - (MUST (MATCH-STRING ";")) - (OPTIONAL (AND METAPGVAR - (PUSH-REDUCTION 'PARSE-RULE1 - (CONS 'PROG - (CONS (TRANSPGVAR METAPGVAR) - (CONS (CONS - 'RETURN - (CONS (POP-STACK-1) NIL)) - NIL)))) - (ACTION (SETQ METAPGVAR NIL)))) - (PUSH-REDUCTION 'PARSE-RULE1 - (MAKE-DEFUN (POP-STACK-3) (POP-STACK-2) (POP-STACK-1))))) - -; FID: IDENTIFIER +#1 ; - -(DEFUN PARSE-FID NIL - (AND (PARSE-IDENTIFIER) - (PUSH-REDUCTION 'PARSE-FID (POP-STACK-1)))) - -; EXPR: SUBEXPR -; < EXPR1* +(OR #2 -#1) -; / EXPR2* +(OR #2 -#1) > ; - -(DEFUN PARSE-EXPR NIL - (AND (PARSE-SUBEXPR) - (OPTIONAL (OR (AND (STAR REPEATOR (PARSE-EXPR1)) - (PUSH-REDUCTION 'PARSE-EXPR - (CONS 'OR - (CONS (POP-STACK-2) - (APPEND (POP-STACK-1) NIL))))) - (AND (STAR REPEATOR (PARSE-EXPR2)) - (PUSH-REDUCTION 'PARSE-EXPR - (CONS 'OR - (CONS (POP-STACK-2) - (APPEND (POP-STACK-1) NIL))))))))) - -; EXPR1: '/' <^'/'> SUBEXPR ; - -(DEFUN PARSE-EXPR1 NIL - (AND (MATCH-ADVANCE-STRING "/") - (OPTIONAL (NOT (MATCH-ADVANCE-STRING "/"))) - (MUST (PARSE-SUBEXPR)))) - -; EXPR2: '\\' <^'\\'> SUBEXPR ; - -(DEFUN PARSE-EXPR2 NIL - (AND (MATCH-ADVANCE-STRING "\\") - (OPTIONAL (NOT (MATCH-ADVANCE-STRING "\\"))) - (MUST (PARSE-SUBEXPR)))) - -; SUBEXPR:FIL_TEST <^?$TRAPFLAG FIL_TEST>*! -; <FIL_TEST <?$TRAPFLAG +(MUST #1)> >*! -; +(#3 -#2 -#1) +=(MAKE-PARSE-FUNCTION #1 "AND) ; - -(DEFUN PARSE-SUBEXPR NIL - (AND (PARSE-FIL_TEST) - (BANG |FIL_TEST| - (OPTIONAL (STAR |OPT_EXPR| - (AND (NOT TRAPFLAG) - (PARSE-FIL_TEST))))) - (BANG |FIL_TEST| - (OPTIONAL (STAR |OPT_EXPR| - (AND (PARSE-FIL_TEST) - (OPTIONAL (AND TRAPFLAG - (PUSH-REDUCTION 'PARSE-SUBEXPR - (CONS - 'MUST - (CONS (POP-STACK-1) NIL)))))) - ))) - (PUSH-REDUCTION 'PARSE-SUBEXPR - (CONS (POP-STACK-3) - (APPEND (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))) - (PUSH-REDUCTION 'PARSE-SUBEXPR (MAKE-PARSE-FUNCTION (POP-STACK-1) 'AND)))) - -; FIL_TEST: REP_TEST <'!' +(BANG FIL_TEST #1)> ; - -(DEFUN PARSE-FIL_TEST NIL - (AND (PARSE-REP_TEST) - (OPTIONAL (AND (MATCH-ADVANCE-STRING "!") - (PUSH-REDUCTION 'PARSE-FIL_TEST - (CONS 'BANG - (CONS '|FIL_TEST| (CONS (POP-STACK-1) NIL)))))))) - -; REP_TEST: N_TEST <REPEATOR> ; - -(DEFUN PARSE-REP_TEST NIL - (AND (PARSE-N_TEST) - (OPTIONAL (PARSE-REPEATOR)))) - -; N_TEST: '^' TEST +(NOT #1) / TEST ; - -(DEFUN PARSE-N_TEST NIL - (OR (AND (MATCH-ADVANCE-STRING "^") - (MUST (PARSE-TEST)) - (PUSH-REDUCTION 'PARSE-N_TEST (CONS 'NOT (CONS (POP-STACK-1) NIL)))) - (PARSE-TEST))) - -; TEST: IDENTIFIER ( '{' <SEXPR*>! '}' -; +(=(INTERN (STRCONC META_PREFIX #2)) -#1) -; / +(=(INTERN (STRCONC META_PREFIX #1)))) .(SETQ TRAPFLAG T) -; / STRING +(MATCH-ADVANCE-STRING #1) .(SETQ TRAPFLAG T) -; / '=' REF_SEXPR .(SETQ TRAPFLAG T) -; / '?' REF_SEXPR .(SETQ TRAPFLAG NIL) -; / '.' SEXPR +(ACTION #1) .(SETQ TRAPFLAG NIL) -; / '+' CONS_SEXPR +(PUSH-REDUCTION =(LIST "QUOTE METARULNAM) #1) -; .(SETQ TRAPFLAG NIL) -; / '(' EXPR ')' .(SETQ TRAPFLAG T) -; / '<' EXPR '>' .(PARSE-OPT_EXPR) .(SETQ TRAPFLAG NIL) ; - -(DEFUN PARSE-TEST NIL - (OR (AND (PARSE-IDENTIFIER) - (MUST (OR (AND (MATCH-ADVANCE-STRING "{") - (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-SEXPR)))) - (MUST (MATCH-ADVANCE-STRING "}")) - (PUSH-REDUCTION 'PARSE-TEST - (CONS (INTERN (STRCONC - |META_PREFIX| - (POP-STACK-2))) - (APPEND (POP-STACK-1) NIL)))) - (PUSH-REDUCTION 'PARSE-TEST - (CONS (INTERN (STRCONC |META_PREFIX| (POP-STACK-1))) - NIL)))) - (ACTION (SETQ TRAPFLAG T))) - (AND (PARSE-STRING) - (PUSH-REDUCTION 'PARSE-TEST - (CONS 'MATCH-ADVANCE-STRING (CONS (POP-STACK-1) NIL))) - (ACTION (SETQ TRAPFLAG T))) - (AND (MATCH-ADVANCE-STRING "=") - (MUST (PARSE-REF_SEXPR)) - (ACTION (SETQ TRAPFLAG T))) - (AND (MATCH-ADVANCE-STRING "?") - (MUST (PARSE-REF_SEXPR)) - (ACTION (SETQ TRAPFLAG NIL))) - (AND (MATCH-ADVANCE-STRING ".") - (MUST (PARSE-SEXPR)) - (PUSH-REDUCTION 'PARSE-TEST (CONS 'ACTION (CONS (POP-STACK-1) NIL))) - (ACTION (SETQ TRAPFLAG NIL))) - (AND (MATCH-ADVANCE-STRING "+") - (MUST (PARSE-CONS_SEXPR)) - (PUSH-REDUCTION 'PARSE-TEST - (CONS 'PUSH-REDUCTION - (CONS (LIST 'QUOTE METARULNAM) (CONS (POP-STACK-1) NIL)))) - (ACTION (SETQ TRAPFLAG NIL))) - (AND (MATCH-ADVANCE-STRING "(") - (MUST (PARSE-EXPR)) - (MUST (MATCH-ADVANCE-STRING ")")) - (ACTION (SETQ TRAPFLAG T))) - (AND (MATCH-ADVANCE-STRING "<") - (MUST (PARSE-EXPR)) - (MUST (MATCH-ADVANCE-STRING ">")) - (ACTION (PARSE-OPT_EXPR)) - (ACTION (SETQ TRAPFLAG NIL))))) - -; SEXPR: IDENTIFIER / NUMBER / STRING / NON_DEST_REF / DEST_REF / LOCAL_VAR -; / '"' SEXPR +(QUOTE #1) / '=' SEXPR / '(' <SEXPR*>! ')' ; - -(DEFUN PARSE-SEXPR NIL - (OR (PARSE-IDENTIFIER) - (PARSE-NUMBER) - (PARSE-STRING) - (PARSE-NON_DEST_REF) - (PARSE-DEST_REF) - (PARSE-LOCAL_VAR) - (AND (MATCH-ADVANCE-STRING "\"") - (MUST (PARSE-SEXPR)) - (PUSH-REDUCTION 'PARSE-SEXPR (CONS 'QUOTE (CONS (POP-STACK-1) NIL)))) - (AND (MATCH-ADVANCE-STRING "=") - (MUST (PARSE-SEXPR))) - (AND (MATCH-ADVANCE-STRING "(") - (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-SEXPR)))) - (MUST (MATCH-ADVANCE-STRING ")"))))) - -; REF_SEXPR: STRING +(MATCH-STRING #1) / SEXPR ; - -(DEFUN PARSE-REF_SEXPR NIL - (OR (AND (PARSE-STRING) - (PUSH-REDUCTION 'PARSE-REF_SEXPR (CONS 'MATCH-STRING (CONS (POP-STACK-1) NIL)))) - (PARSE-SEXPR))) - -; CONS_SEXPR: IDENTIFIER <^=(MEMBER ##1 METAPGVAR) +(QUOTE #1)> -; / LOCAL_VAR +(QUOTE #1) -; / '(' <SEXPR_STRING>! ')' -; / SEXPR ; - -(DEFUN PARSE-CONS_SEXPR NIL - (OR (AND (PARSE-IDENTIFIER) - (OPTIONAL (AND (NOT (MEMBER (NTH-STACK 1) METAPGVAR)) - (PUSH-REDUCTION 'PARSE-CONS_SEXPR - (CONS 'QUOTE (CONS (POP-STACK-1) NIL)))))) - (AND (PARSE-LOCAL_VAR) - (PUSH-REDUCTION 'PARSE-CONS_SEXPR (CONS 'QUOTE (CONS (POP-STACK-1) NIL)))) - (AND (MATCH-ADVANCE-STRING "(") - (BANG |FIL_TEST| (OPTIONAL (PARSE-SEXPR_STRING))) - (MUST (MATCH-ADVANCE-STRING ")"))) - (PARSE-SEXPR))) - -; SEXPR_STRING: CONS_SEXPR <SEXPR_STRING>! +(CONS #2 #1) -; / '-' CONS_SEXPR <SEXPR_STRING>! +(APPEND #2 #1) ; - -(DEFUN PARSE-SEXPR_STRING NIL - (OR (AND (PARSE-CONS_SEXPR) - (BANG |FIL_TEST| (OPTIONAL (PARSE-SEXPR_STRING))) - (PUSH-REDUCTION 'PARSE-SEXPR_STRING - (CONS 'CONS (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))) - (AND (MATCH-ADVANCE-STRING "-") - (MUST (PARSE-CONS_SEXPR)) - (BANG |FIL_TEST| (OPTIONAL (PARSE-SEXPR_STRING))) - (PUSH-REDUCTION 'PARSE-SEXPR_STRING - (CONS 'APPEND (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) - -; NON_DEST_REF: '##' NUMBER +(NTH-STACK #1) ; - -(DEFUN PARSE-NON_DEST_REF NIL - (AND (MATCH-ADVANCE-STRING "##") - (MUST (PARSE-NUMBER)) - (PUSH-REDUCTION 'PARSE-NON_DEST_REF (CONS 'NTH-STACK (CONS (POP-STACK-1) NIL))))) - -; DEST_REF: '#' NUMBER +=(LIST (INTERN (STRCONC 'POP-STACK-' (STRINGIMAGE #1)))) ; - -(DEFUN PARSE-DEST_REF NIL - (AND (MATCH-ADVANCE-STRING "#") - (MUST (PARSE-NUMBER)) - (PUSH-REDUCTION 'PARSE-DEST_REF - (LIST (INTERN (STRCONC "POP-STACK-" (STRINGIMAGE (POP-STACK-1)))))))) - -; LOCAL_VAR: '$' ( IDENTIFIER / NUMBER +=(GETGENSYM #1) .(PUSH ##1 METAPGVAR)) ; - -(DEFUN PARSE-LOCAL_VAR NIL - (AND (MATCH-ADVANCE-STRING "$") - (MUST (OR (PARSE-IDENTIFIER) - (AND (PARSE-NUMBER) - (PUSH-REDUCTION 'PARSE-LOCAL_VAR (GETGENSYM (POP-STACK-1))) - (ACTION (PUSH (NTH-STACK 1) METAPGVAR))))))) - -; OPT_EXPR: <'*' +(STAR OPT_EXPR #1) / REPEATOR> +(OPTIONAL #1) ; - -(DEFUN PARSE-OPT_EXPR NIL - (AND (OPTIONAL (OR (AND (MATCH-ADVANCE-STRING "*") - (PUSH-REDUCTION 'PARSE-OPT_EXPR - (CONS 'STAR - (CONS '|OPT_EXPR| - (CONS (POP-STACK-1) NIL))))) - (PARSE-REPEATOR))) - (PUSH-REDUCTION 'PARSE-OPT_EXPR (CONS 'OPTIONAL (CONS (POP-STACK-1) NIL))))) - -; REPEATOR: ('*' / BSTRING +(AND (MATCH-ADVANCE-STRING #1) (MUST ##1))) -; +(STAR REPEATOR #1) ; - -(DEFUN PARSE-REPEATOR NIL - (AND (OR (MATCH-ADVANCE-STRING "*") - (AND (PARSE-BSTRING) - (PUSH-REDUCTION 'PARSE-REPEATOR - (CONS 'AND - (CONS (CONS 'MATCH-ADVANCE-STRING - (CONS (POP-STACK-1) NIL)) - (CONS (CONS 'MUST (CONS (NTH-STACK 1) NIL)) - NIL)))))) - (PUSH-REDUCTION 'PARSE-REPEATOR - (CONS 'STAR (CONS 'REPEATOR (CONS (POP-STACK-1) NIL)))))) - -; .FIN ; -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/spad.lisp.pamphlet b/src/interp/spad.lisp.pamphlet index 382ffc6a..6a9fa709 100644 --- a/src/interp/spad.lisp.pamphlet +++ b/src/interp/spad.lisp.pamphlet @@ -132,32 +132,8 @@ (defvar |$IOAlist| '((|%i| . (|gauss| 0 1)))) (setq |$useBFasDefault| T) (defvar |InteractiveMode|) -(defvar |New-LEXPR|) (defvar |NewFLAG| t) (defvar |uc| 'UC) -(setq |$lisp2lispRenameAssoc| '((RETURN . |return|) - (EXIT . |exit|) - (AND . |and|) - (OR . |or|) - (NOT . |not|) - (IS . |is|) - (CAR . |first|) - (CDR . |rest|) - (EQUAL . =) - (NEQUAL . ^=) - (PLUS . +) - (TIMES . *) - (QUOTIENT . /) - (EXPT . **) - (SUBST . |substitute|) - (NULL . ^) - (ATOM . |atom|) - (NULL . |null|) - )) - -(setq |$spadOpList| - '(\.\. - = * / ** + - \< \> \<= \>= ^= \# \' ^ - \: \:\: \. =\> == ==\> \| \:=)) (DEFUN INTEGER-BIT (N I) (LOGBITP I N)) @@ -173,19 +149,6 @@ (COPY-TREE |$InitialModemapFrame|)))) (RETURN (PROGN (S-PROCESS X) NIL)))) -(DEFUN /TRANSBOOT (X) (S-PROCESS X) NIL) - -(DEFUN /TRANSNBOOT (X) (S-PROCESS X) NIL) - -(DEFUN /TRANSMETA (X) - (PROG (KEYNAM ROOTFN U) - (SETQ ROOTFN (/MFINDROOT (CAR /SOURCEFILES))) - (SETQ $LASTPREFIX (GET ROOTFN 'METAPFX)) - (SETQ KEYNAM (INTERNL $LASTPREFIX (PNAME ROOTFN) "KEY")) - (SET KEYNAM (REMDUP (APPEND METAKEYLST (EVAL KEYNAM)))) - (SETQ U (GETRULEFUNLISTS ROOTFN (LIST X))) - (SUBLISNQ (PAIR (CADR U) (CAR U)) X))) - ;; NIL needed below since END\_UNIT is not generated by current parser (defun |isTokenDelimiter| () (MEMBER (CURRENT-SYMBOL) '(\) END\_UNIT NIL))) @@ -222,10 +185,6 @@ (defun READ-SPAD-1 () (|New,ENTRY,1|)) -(defun BOOT-LEXPR () (SETQ $BOOT 'T) (SPAD-LEXPR1)) - -(defun NBOOT-LEXPR () (SETQ $NBOOT 'T) (SPAD-LEXPR1)) - (defun UNCONS (X) (COND ((ATOM X) X) ((EQCAR X 'CONS) (CONS (SECOND X) (UNCONS (THIRD X)))) @@ -242,21 +201,6 @@ (defun SPAD-MODETRAN (X) (D-TRAN X)) -(defun SPAD-MDTR-1 (X) - (COND - ((ATOM X) (LIST (LIST X))) - ((EQCAR X 'LIST) (SPAD-MDTR-2 (CDR X))) - (T (CROAK "MODE TRANSFORM ERROR")))) - -(defun SPAD-MDTR-2 (L) - (COND - ((NOT L) L) - ((ATOM (FIRST L)) - (COND - ((MEMBER (FIRST L) $DOMVAR) (FIRST L)) - (T (CONS (LIST (LIST (FIRST L))) (SPAD-MDTR-2 (CDR L)))) )) - (T (CONS (FIRST L) (SPAD-MDTR-2 (CDR L)))))) - (defun SPAD-EVAL (X) (COND ((ATOM X) (EVAL X)) ((CONS (FIRST X) (MAPCAR #'SPAD-EVAL (CDR X)))))) @@ -461,27 +405,6 @@ (defun |evalSharpOne| (x \#1) (declare (special \#1)) (EVAL x)) -(defun new () (|New,ENTRY|)) - -(defun newpo () (let ((|$PrintOnly| t)) (new))) - -(defun |New,ENTRY| () - (let ((|$InteractiveMode| t)(inputstream in-stream) ) - (declare (special inputstream)) - (spad))) - -(defun |New,ENTRY,SYS| () - (let (|$InteractiveMode|) - (|New,ENTRY1|))) - -(defun |New,ENTRY1| () - (let ((spaderrorstream curoutstream) $boot (curinstream curinstream) - (strm curinstream)) - (SETQ CURINSTREAM *terminal-io*) - (|New,ENTRY,1|) - (SETQ CURINSTREAM STRM) - 'END_OF_New)) - (setq *PROMPT* 'LISP) (defun |New,ENTRY,1| () @@ -517,20 +440,8 @@ (defun INITIALIZE () (init-boot/spad-reader) (initialize-preparse INPUTSTREAM)) -(defun New-LEXPR () (New-LEXPR1)) - -(defun New-LEXPR-Interactive () (setq |$InteractiveMode| t) (New-LEXPR1)) - (setq *prompt* 'new) -(defun New-LEXPR1 () - (FLAG |boot-NewKEY| 'KEY) - (SETLINE (SUB1 (file-position INPUTSTREAM)) INPUTSTREAM) - (SETQ CHR 'ENDOFLINECHR) - (NXTTOK) - (|boot-Statement|) - (CAR STACK)) - (defun parserState () (PRINT (LIST 'CHR= CHR 'NBLNK= NBLNK 'TOK= TOK 'ISID= ISID 'COUNT= COUNT 'COLUMN= COLUMN)) @@ -560,85 +471,6 @@ (COLLECT |formatCOLLECT|) (REDUCE |formatREDUCE|))) -(defun |boot2Lisp| (LINESET) - (let* (($TOP_STACK T) (*PROMPT* 'New) ($MAXLINENUMBER 0) - (NewFLAG T) (XTRANS '|boot-New|) (XCAPE '!) - (COMMENTCHR 'NOTHING) (XTOKENREADER 'NewSYSTOK) - ($NBOOT T) (ERRCOL 0) (COUNT 0) (COLUMN 0) - (TRAPFLAG NIL) (OK T) (SPADERRORSTREAM CUROUTSTREAM) - ($LINESTACK 'BEGIN_UNIT) - (INPUTSTREAM LINESET) - (CHR 'ENDOFLINECHR)) - (REMFLAG S-SPADKEY 'KEY) - (FLAG |boot-NewKEY| 'KEY) - (NXTTOK) ; causes PREPARSE to be called - (|boot-Statement|) - (REMFLAG |boot-NewKEY| 'KEY) - (FLAG S-SPADKEY 'KEY) - (if (NULL OK) (|boot2LispError|)) - (|new2OldLisp| (CAR STACK)))) - -(defun /cx (L) - "CAUTION: will not work if function in L has DEFLOC with ft=NBOOT" - (if (not L) (SETQ L |$LastCxArg|)) - (SETQ |$LastCxArg| L) - (/D-1 L '|lisp2BootAndCompare| NIL NIL)) - -(defun /foobar (L) - (let (($xCount 0)) - (if (not L) (SETQ L $LastCxArg)) - (SETQ $LastCxArg L) - (/D-1 L 'foobar NIL NIL))) - -(defun foobar (X) |$xCount|) - -(defun |/cxd| (L) - (if (NULL L) (SETQ L $|LastCxArg|)) - (SETQ |$LastCxArg| L) - (/D-1 L '|lispOfBoot2NBootAndCompare| NIL NIL)) - -(defun |/rx| (L) - (let ((DEF-RENAME 'IDENTITY) - (DEF-PROCESS '|lispOfBoot2NBootAndCompare|) ) - (declare (SPECIAL DEF-RENAME DEF-PROCESS)) - (if (OR (NULL L) (NULL (ATOM (CAR L)))) - (EVAL (APPEND (CONS '/RF /EDITFILE) L)) - (CATCH 'FILENAM (/RF-1 L))))) - -(defun |/ry| (L) - (let ((DEF-RENAME 'IDENTITY) - (DEF-PROCESS '|pp|) ) - (declare (SPECIAL DEF-RENAME DEF-PROCESS)) - (if (OR (NULL L) (NULL (ATOM (CAR L)))) - (EVAL (APPEND (CONS '/RF /EDITFILE) L)) - (CATCH 'FILENAM (/RF-1 L))))) - -(defun |/tb| (L) - (let ((DEF-RENAME 'IDENTITY) (DEF-PROCESS 'lispOfBoot2NBAC1)) - (declare (special DEF-RENAME DEF-PROCESS)) - (if (NULL L) - (EVAL (CONS '/RQ /EDITFILE)) - (CATCH 'FILENAM - (PROG (OUTFILE ($PRETTYPRINT T)) - (SETQ /EDITFILE (LIST (CAR L) 'BOOT '*)) - (OBEY (STRCONC "ERASE " (PNAME (CAR /EDITFILE)) " NBOOT E1")) - (SETQ OUTFILE (LIST (CAR /EDITFILE) 'NBOOT 'E1)) - (RETURN (/RF-1 (APPEND /EDITFILE - (LIST (CONS 'TO= OUTFILE)))))))))) - -(defun |boot2LispError| () - "Print syntax error indication, underline character, scrub line." - (COND ((OR (EQ DEBUGMODE 'YES) (NULL (CONSOLEINPUTP INPUTSTREAM))) - (SPAD_LONG_ERROR)) - (T (SPAD_SHORT_ERROR))) - (SETQ OK T)) - -(defun |getTranslation| (|function| |fn| |ft| |rdr|) - (let ((|New-LEXPR| |rdr|) (|$TranslateOnly| T)) - (declare (special |New-LEXPR| |$TranslateOnly|)) - (/D-1 (LIST |function| (LIST 'FROM= |fn| |ft|)) 'IDENTITY NIL NIL) - |$Translation|)) - (defmacro |incTimeSum| (a b) (if (not |$InteractiveTimingStatsIfTrue|) a (let ((key b) (oldkey (gensym)) (val (gensym))) @@ -727,8 +559,6 @@ (defvar DOLLAR "$") (defvar COLON ":") -; (SETQ |boot-NewKEY| (S- |boot-NewKEY| '(|cp| |cms| |lisp| |boot|))) - (FLAG TEMPGENSYMLIST 'IS-GENSYM) (MAKEPROP 'COND '|Nud| '(|if| |if| 130 0)) |