diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 515abb1..80a1e06 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -11644,6 +11644,15 @@ If it is successful, advance inputstream past X. @ +\defun{isTokenDelimiter}{isTokenDelimiter} +NIL needed below since END\_UNIT is not generated by current parser +\calls{isTokenDelimiter}{current-symbol} +<>= +(defun |isTokenDelimiter| () + (member (current-symbol) '(\) end\_unit nil))) + +@ + \defun{underscore}{underscore} \calls{underscore}{vector-push} <>= @@ -15032,6 +15041,7 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> <> diff --git a/changelog b/changelog index b017c98..9666820 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20101216 tpd src/axiom-website/patches.html 20101216.01.tpd.patch +20101216 tpd src/interp/vmlisp.lisp treeshake compiler +20101216 tpd src/interp/parsing.lisp treeshake compiler +20101216 tpd books/bookvol9 treeshake compiler 20101214 tpd src/axiom-website/patches.html 20101214.01.tpd.patch 20101214 tpd src/interp/vmlisp.lisp treeshake compiler 20101214 tpd src/interp/parsing.lisp treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index c94cd83..e85faed 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3317,5 +3317,7 @@ books/bookvolbib add [Pra73] Top down operator precedence
books/bookvolbib add [Flo63] Floyd
20101214.01.tpd.patch books/bookvol9 treeshake compiler
+20101216.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 090ce11..fe50711 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -730,7 +730,7 @@ bootlex ($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) + (|New,ENTRY,1|) (close SPADERRORSTREAM) (SETQ IN-STREAM STRM) (OR (EQUAL #(0 0 0) $SPAD_ERRORS) diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index b45d9df..2bc7f8b 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -4572,11 +4572,8 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (MAKEPROP 'BOOT '/TERMCHR '(#\: #\< #\ #\()) (MAKEPROP 'META '/READFUN 'META\,RULE) (MAKEPROP 'INPUT '/READFUN '|New,LEXPR,Interactive|) -(MAKEPROP 'INPUT '/TRAN '/TRANSPAD) (MAKEPROP 'BOOT '/READFUN '|New,LEXPR1|) -(MAKEPROP 'BOOT '/TRAN '/TRANSNBOOT) (MAKEPROP 'SPAD '/READFUN '|New,LEXPR|) -(MAKEPROP 'SPAD '/TRAN '/TRANSPAD) (defmacro |/C,LIB| (&rest L &aux optionlist /editfile ($prettyprint 't) ($reportCompilation 't)) @@ -5665,7 +5662,6 @@ now the function is defined but does nothing. (defvar /rp '/RP) (defvar error-print) (defvar ind) -(defvar JUNKTOKLIST '(FOR IN AS INTO OF TO)) (defvar m-chrbuffer) (defvar m-chrindex) (defvar MARG 0 "Margin for testing by ?OP") @@ -5676,137 +5672,10 @@ now the function is defined but does nothing. (setq |$useBFasDefault| T) (defvar |New-LEXPR|) -(DEFUN INTEGER-BIT (N I) (LOGBITP I N)) - -(DEFUN /TRANSPAD (X) - (PROG (proplist) - (setq proplist (LIST '(FLUID . |true|) - (CONS 'special - (COPY-TREE |$InitialDomainsInScope|)))) - (SETQ |$tripleCache| NIL) - (SETQ |$InteractiveFrame| - (|addBinding| '|$DomainsInScope| proplist - (|addBinding| '|$Information| NIL - (COPY-TREE |$InitialModemapFrame|)))) - (RETURN (PROGN (S-PROCESS X) NIL)))) - -(DEFUN /TRANSBOOT (X) (S-PROCESS X) NIL) - -(DEFUN /TRANSNBOOT (X) (S-PROCESS X) NIL) - - ;; NIL needed below since END\_UNIT is not generated by current parser -(defun |isTokenDelimiter| () (MEMBER (CURRENT-SYMBOL) '(\) END\_UNIT NIL))) - -(defun |traceComp| () - (SETQ |$compCount| 0) - (EMBED '|comp| - '(LAMBDA (X Y Z) - (PROG (U) - (SETQ |$compCount| (1+ |$compCount|)) - (SETQ |yesOrNo| (if (SETQ U (|comp| X Y Z)) - (if (EQUAL (SECOND U) Y) '|yes| (SECOND U)) - ('T '|no|))) - (|sayBrightly| (CONS (MAKE-FULL-CVEC |$compCount| " ") - (LIST X " --> " Y '|%b| |yesOrNo| '|%d|))) - (SETQ |$compCount| (1- |$compCount|)) - (RETURN U) ))) - (|comp| $x $m $f) - (UNEMBED '|comp|)) - -(defun READ-SPAD (FN FM TO) - (LET ((proplist - (LIST '(FLUID . |true|) - (CONS 'special (COPY-TREE |$InitialDomainsInScope|))))) - (SETQ |$InteractiveFrame| - (|addBinding| '|$DomainsInScope| proplist - (|addBinding| '|$Information| NIL - (|makeInitialModemapFrame|)))) - (READ-SPAD0 FN 'SPAD FM TO))) - -(defun READ-INPUT (FN FM TO) (READ-SPAD0 FN 'INPUT FM TO)) - -(defun READ-SPAD0 (FN FT FM TO) - (let (($newspad t)) (READ-SPAD1 FN FT FM TO))) - -(defun READ-SPAD-1 () (|New,ENTRY,1|)) - -(defun UNCONS (X) - (COND ((ATOM X) X) - ((EQCAR X 'CONS) (CONS (SECOND X) (UNCONS (THIRD X)))) - (T (ERROR "UNCONS")))) - -(defun OPTIMIZE\&PRINT (X) (PRETTYPRINT (/MDEF X))) - -(defun SPAD-PRINTTIME (A B) - (let (c msg) - (setq C (+ A B)) - (setq MSG (STRCONC "(" (STRINGIMAGE A) " + " (STRINGIMAGE B) - " = " (STRINGIMAGE C) " MS.)")) - (PRINT (STRCONC (STRINGPAD "" (- 80 (SIZE MSG))) MSG)))) - -(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)))))) - ;************************************************************************ ; SYSTEM COMMANDS ;************************************************************************ - -(defun /EDIT (L) - (SETQ /EDITFILE L) - (/EF) - (|terminateSystemCommand|) - (|spadPrompt|)) - -(defun /COMPINTERP (L OPTS) - (SETQ /EDITFILE (/MKINFILENAM L)) - (COND ((EQUAL OPTS "rf") (/RF)) - ((EQUAL OPTS "rq") (/RQ)) - ('T (/RQ-LIB))) - (|terminateSystemCommand|) - (|spadPrompt|)) - -(defun STREAM2UC (STRM) - (LET ((X (ELT (LASTATOM STRM) 1))) (SETELT X 0 (upcase (ELT X 0))))) - -(defun NEWNAMTRANS (X) - (COND - ((IDENTP X) (COND ( (GET X 'NEWNAM) (GET X 'NEWNAM)) ('T X))) - ((STRINGP X) X) - ((*VECP X) (MAPVWOC X (FUNCTION NEWNAMTRANS))) - ((ATOM X) X) - ((EQCAR X 'QUOTE)) - (T (CONS (NEWNAMTRANS (FIRST X)) (NEWNAMTRANS (CDR X)))))) - -(defun GP2COND (L) - (COND ((NOT L) (ERROR "GP2COND")) - ((NOT (CDR L)) - (COND ((EQCAR (FIRST L) 'COLON) - (CONS (SECOND L) (LIST (LIST T 'FAIL)))) - (T (LIST (LIST T (FIRST L)))) )) - ((EQCAR (FIRST L) 'COLON) (CONS (CDAR L) (GP2COND (CDR L)))) - (T (ERROR "GP2COND")))) - -(FLAG JUNKTOKLIST 'KEY) - (defmacro |report| (L) (SUBST (SECOND L) 'x '(COND ($reportFlag (sayBrightly x)) ((QUOTE T) NIL))))