diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 7f5761e..56f5ff8 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1322,38 +1322,17 @@ leave it alone." @ -\section{Line Handling} - -\defun{storeblanks}{storeblanks} -<>= -(defun storeblanks (line n) - (do ((i 0 (1+ i))) - ((= i n) line) - (setf (char line i) #\ ))) - -@ - -\defun{initial-substring}{initial-substring} -\calls{initial-substring}{mismatch} -<>= -(defun initial-substring (pattern line) - (let ((ind (mismatch pattern line))) - (or (null ind) (eql ind (size pattern))))) - -@ - -\defun{get-a-line}{get-a-line} -\calls{get-a-line}{is-console} -\calls{get-a-line}{mkprompt} -\calls{get-a-line}{read-a-line} -\calls{get-a-line}{make-string-adjustable} -<>= -(defun get-a-line (stream) - (when (is-console stream) (princ (mkprompt))) - (let ((ll (read-a-line stream))) - (if (stringp ll) - (make-string-adjustable ll) - ll))) +\section{I/O Handling} +\defun{preparse-echo}{preparse-echo} +\uses{preparse-echo}{Echo-Meta} +\usesdollar{preparse-echo}{EchoLineStack} +<>= +(defun preparse-echo (linelist) + (declare (special $EchoLineStack Echo-Meta)) + (if Echo-Meta + (dolist (x (reverse $EchoLineStack)) + (format out-stream "~&;~A~%" x))) + (setq $EchoLineStack ())) @ @@ -1390,6 +1369,41 @@ Symbolics read-line returns embedded newlines in a c-m-Y.") @ +\section{Line Handling} + +\defun{storeblanks}{storeblanks} +<>= +(defun storeblanks (line n) + (do ((i 0 (1+ i))) + ((= i n) line) + (setf (char line i) #\ ))) + +@ + +\defun{initial-substring}{initial-substring} +\calls{initial-substring}{mismatch} +<>= +(defun initial-substring (pattern line) + (let ((ind (mismatch pattern line))) + (or (null ind) (eql ind (size pattern))))) + +@ + +\defun{get-a-line}{get-a-line} +\calls{get-a-line}{is-console} +\calls{get-a-line}{mkprompt} +\calls{get-a-line}{read-a-line} +\calls{get-a-line}{make-string-adjustable} +<>= +(defun get-a-line (stream) + (when (is-console stream) (princ (mkprompt))) + (let ((ll (read-a-line stream))) + (if (stringp ll) + (make-string-adjustable ll) + ll))) + +@ + \defun{make-string-adjustable}{make-string-adjustable} <>= (defun make-string-adjustable (s) @@ -1400,6 +1414,45 @@ Symbolics read-line returns embedded newlines in a c-m-Y.") @ +\chapter{Transformers} +\defun{postTransform}{postTransform} +\calls{postTransform}{postTran} +\calls{postTransform}{identp} +\calls{postTransform}{postTransformCheck} +\calls{postTransform}{aplTran} +<>= +(defun |postTransform| (y) + (let (x tmp1 tmp2 tmp3 tmp4 tmp5 tt l u) + (setq x y) + (setq u (|postTran| x)) + (when + (and (pairp u) (eq (qcar u) '|@Tuple|) + (progn + (setq tmp1 (qcdr u)) + (and (pairp tmp1) + (progn (setq tmp2 (reverse tmp1)) t) + (pairp tmp2) + (progn + (setq tmp3 (qcar tmp2)) + (and (pairp tmp3) + (eq (qcar tmp3) '|:|) + (progn + (setq tmp4 (qcdr tmp3)) + (and (pairp tmp4) + (progn + (setq y (qcar tmp4)) + (setq tmp5 (qcdr tmp4)) + (and (pairp tmp5) + (eq (qcdr tmp5) nil) + (progn (setq tt (qcar tmp5)) t))))))) + (progn (setq l (qcdr tmp2)) t) + (progn (setq l (nreverse l)) t))) + (dolist (x l t) (unless (identp x) (return nil)))) + (setq u (list '|:| (cons 'listof (append l (list y))) tt))) + (|postTransformCheck| u) + (|aplTran| u))) + +@ \chapter{The Compiler} \section{Compiling EQ.spad} @@ -4517,8 +4570,10 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> +<> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 9870178..51ed36d 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20101003 tpd src/axiom-website/patches.html 20101003.02.tpd.patch +20101003 tpd src/interp/parsing.lisp treeshake compiler +20101003 tpd books/bookvol9 treeshake compiler 20101003 tpd src/axiom-website/patches.html 20101003.01.tpd.patch 20101003 tpd src/interp/vmlisp.lisp remove droptrailingblanks 20101003 tpd src/interp/i-output.lisp remove droptrailingblanks diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 28589cf..160943d 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3180,5 +3180,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20101003.01.tpd.patch books/bookvol9 treeshake compiler
+20101003.02.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 129d2fb..f841549 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -3260,11 +3260,6 @@ preparse ((INITIAL-SUBSTRING LINE ")fin") (RETURN (CONS IND NIL))) ('T (RETURN (SKIP-TO-ENDIF X)))))) -(defun PREPARSE-ECHO (linelist) - (if Echo-Meta (REPEAT (IN X (REVERSE $EchoLineStack)) - (format out-stream "~&;~A~%" X))) - (setq $EchoLineStack ())) - (defun ESCAPED (STR N) (and (> N 0) (EQ (CHAR STR (1- N)) XCAPE))) (defun INFIXTOK (S) (MEMBER (STRING2ID-N S 1) '(|then| |else|) :test #'eq)) @@ -4033,23 +4028,7 @@ parse (DEFUN |parseVCONS| (|l|) (CONS (QUOTE VECTOR) (|parseTranList| |l|))) ;;;Boot translation finished for parse.boot -@ -postpar -<<*>>= -;--% Yet Another Parser Transformation File -;--These functions are used by for BOOT and SPAD code -;--(see new2OldLisp, e.g.) -;postTransform y == -; x:= y -; u:= postTran x -; if u is ['Tuple,:l,[":",y,t]] and (and/[IDENTP x for x in l]) then u:= -; [":",['LISTOF,:l,y],t] -; postTransformCheck u -; aplTran u - -;;; *** |postTransform| REDEFINED -(DEFUN |postTransform| (|y|) (PROG (|x| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |t| |l| |u|) (RETURN (SEQ (PROGN (SPADLET |x| |y|) (SPADLET |u| (|postTran| |x|)) (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |@Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (PROGN (SPADLET |y| (QCAR |ISTMP#4|)) (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G166116) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G166122 NIL (NULL #0#)) (#2=#:G166123 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (IDENTP |x|))))))))) (SPADLET |u| (CONS (QUOTE |:|) (CONS (CONS (QUOTE LISTOF) (APPEND |l| (CONS |y| NIL))) (CONS |t| NIL)))))) (|postTransformCheck| |u|) (|aplTran| |u|)))))) ;displayPreCompilationErrors() == ; n:= #($postStack:= REMDUP NREVERSE $postStack) ; n=0 => nil