diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 3b2bd42..4a608b5 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -8144,6 +8144,37 @@ of the symbol being parsed. The original list read: \end{chunk} +\defun{postCapsule}{postCapsule} +\calls{postCapsule}{checkWarning} +\calls{postCapsule}{postBlockItem} +\calls{postCapsule}{postBlockItemList} +\calls{postCapsule}{postFlatten} +\begin{chunk}{defun postCapsule} +(defun |postCapsule| (x) + (let (op) + (cond + ((null (and (pairp x) (progn (setq op (qcar x)) t))) + (|checkWarning| (list "Apparent indentation error following add"))) + ((or (integerp op) (eq op '==)) + (list 'capsule (|postBlockItem| x))) + ((eq op '|;|) + (cons 'capsule (|postBlockItemList| (|postFlatten| x '|;|)))) + ((eq op '|if|) + (list 'capsule (|postBlockItem| x))) + (t (|checkWarning| (list "Apparent indentation error following add")))))) + +\end{chunk} + +\defun{postBlockItemList}{postBlockItemList} +\calls{postBlockItemList}{postBlockItem} +\begin{chunk}{defun postBlockItemList} +(defun |postBlockItemList| (args) + (let (result) + (dolist (item args (nreverse result)) + (push (|postBlockItem| item) result)))) + +\end{chunk} + \defplist{@}{postAtSign} \begin{chunk}{postvars} (eval-when (eval load) @@ -8267,6 +8298,25 @@ of the symbol being parsed. The original list read: \end{chunk} +\defun{postMakeCons}{postMakeCons} +\calls{postMakeCons}{postMakeCons} +\calls{postMakeCons}{postTran} +\begin{chunk}{defun postMakeCons} +(defun |postMakeCons| (args) + (let (a b) + (cond + ((null args) '|nil|) + ((and (pairp args) (pairp (qcar args)) (eq (qcar (qcar args)) '|:|) + (pairp (qcdr (qcar args))) (eq (qcdr (qcdr (qcar args))) nil)) + (setq a (qcar (qcdr (qcar args)))) + (setq b (qcdr args)) + (if b + (list '|append| (|postTran| a) (|postMakeCons| b)) + (|postTran| a))) + (t (list '|cons| (|postTran| (car args)) (|postMakeCons| (cdr args))))))) + +\end{chunk} + \defplist{collect}{postCollect} \begin{chunk}{postvars} (eval-when (eval load) @@ -8797,6 +8847,21 @@ of the symbol being parsed. The original list read: \end{chunk} +\defun{postFlattenLeft}{postFlattenLeft} +\calls{postFlattenLeft}{postFlattenLeft} +\begin{chunk}{defun postFlattenLeft} +(defun |postFlattenLeft| (x op) + (let (a b) + (cond + ((and (pairp x) (equal (qcar x) op) (pairp (qcdr x)) + (pairp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + (setq a (qcar (qcdr x))) + (setq b (qcar (qcdr (qcdr x)))) + (append (|postFlattenLeft| a op) (list b))) + (t (list x))))) + +\end{chunk} + \defplist{Signature}{postSignature} \begin{chunk}{postvars} (eval-when (eval load) @@ -11403,6 +11468,15 @@ Stack of results of reduced productions. \chapter{Utility Functions} +\defun{checkWarning}{checkWarning} +\calls{checkWarning}{postError} +\calls{checkWarning}{concat} +\begin{chunk}{defun checkWarning} +(defun |checkWarning| (msg) + (|postError| (|concat| "Parsing error: " msg))) + +\end{chunk} + \defun{tuple2List}{tuple2List} \calls{tuple2List}{tuple2List} \calls{tuple2List}{postTranSegment} @@ -14412,6 +14486,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun char-eq} \getchunk{defun char-ne} +\getchunk{defun checkWarning} \getchunk{defun comma2Tuple} \getchunk{defun comp} \getchunk{defun comp2} @@ -14536,6 +14611,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun line-print} \getchunk{defun line-new-line} +\getchunk{defun postMakeCons} \getchunk{defun make-string-adjustable} \getchunk{defun make-symbol-of} \getchunk{defun match-advance-string} @@ -14644,6 +14720,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun parseEquivalence} \getchunk{defun parseExit} \getchunk{defun postFlatten} +\getchunk{defun postFlattenLeft} \getchunk{defun postForm} \getchunk{defun parseGreaterEqual} \getchunk{defun parseGreaterThan} @@ -14680,6 +14757,8 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun postAtSign} \getchunk{defun postBigFloat} \getchunk{defun postBlock} +\getchunk{defun postBlockItemList} +\getchunk{defun postCapsule} \getchunk{defun postCategory} \getchunk{defun postcheck} \getchunk{defun postCollect} diff --git a/changelog b/changelog index 1b5ec7f..d33e9ab 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20110301 tpd src/axiom-website/patches.html 20110301.03.tpd.patch +20110301 tpd src/interp/parsing.lisp treeshake compiler +20110301 tpd books/bookvol9 treeshake compiler 20110301 tpd src/axiom-website/patches.html 20110301.02.tpd.patch 20110301 tpd src/interp/parsing.lisp treeshake compiler 20110301 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index d540650..7d469f7 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3419,5 +3419,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20110301.02.tpd.patch books/bookvol9 treeshake compiler
+20110301.03.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index a856001..a0276ef 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -1601,50 +1601,6 @@ parse (DEFUN |displayPreCompilationErrors| NIL (PROG (|n| |errors| |heading|) (RETURN (SEQ (PROGN (SPADLET |n| (|#| (SPADLET |$postStack| (REMDUP (NREVERSE |$postStack|))))) (COND ((EQL |n| 0) NIL) ((QUOTE T) (SPADLET |errors| (COND ((> |n| 1) "errors") ((QUOTE T) "error"))) (COND (|$InteractiveMode| (|sayBrightly| (CONS " Semantic " (CONS |errors| (CONS " detected: " NIL))))) ((QUOTE T) (SPADLET |heading| (COND ((NEQUAL |$topOp| (QUOTE |$topOp|)) (CONS " " (CONS |$topOp| (CONS " has" NIL)))) ((QUOTE T) (CONS " You have" NIL)))) (|sayBrightly| (APPEND |heading| (CONS (QUOTE |%b|) (CONS |n| (CONS (QUOTE |%d|) (CONS "precompilation " (CONS |errors| (CONS ":" NIL)))))))))) (COND ((> |n| 1) (DO ((#0=#:G166154 |$postStack| (CDR #0#)) (|x| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (|sayMath| (CONS " " (CONS |i| (CONS ") " |x|)))))))) ((QUOTE T) (|sayMath| (CONS " " (CAR |$postStack|))))) (TERPRI)))))))) -;checkWarning msg == postError concat('"Parsing error: ",msg) - -;;; *** |checkWarning| REDEFINED - -(DEFUN |checkWarning| (|msg|) (|postError| (|concat| "Parsing error: " |msg|))) -; -;checkWarningIndentation() == -; checkWarning ['"Apparent indentation error following",:bright "add"] - -;;; *** |checkWarningIndentation| REDEFINED - -(DEFUN |checkWarningIndentation| NIL (|checkWarning| (CONS "Apparent indentation error following" (|bright| (QUOTE |add|))))) -;postCapsule x == -; x isnt [op,:.] => checkWarningIndentation() -; INTEGERP op or op = "==" => ['CAPSULE,postBlockItem x] -; op = ";" => ['CAPSULE,:postBlockItemList postFlatten(x,";")] -; op = "if" => ['CAPSULE,postBlockItem x] -; checkWarningIndentation() - -;;; *** |postCapsule| REDEFINED - -(DEFUN |postCapsule| (|x|) (PROG (|op|) (RETURN (COND ((NULL (AND (PAIRP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T)))) (|checkWarningIndentation|)) ((OR (integerp |op|) (BOOT-EQUAL |op| (QUOTE ==))) (CONS (QUOTE CAPSULE) (CONS (|postBlockItem| |x|) NIL))) ((BOOT-EQUAL |op| (QUOTE |;|)) (CONS (QUOTE CAPSULE) (|postBlockItemList| (|postFlatten| |x| (QUOTE |;|))))) ((BOOT-EQUAL |op| (QUOTE |if|)) (CONS (QUOTE CAPSULE) (CONS (|postBlockItem| |x|) NIL))) ((QUOTE T) (|checkWarningIndentation|)))))) -;postMakeCons l == -; null l => 'nil -; l is [[":",a],:l'] => -; l' => ['append,postTran a,postMakeCons l'] -; postTran a -; ['cons,postTran first l,postMakeCons rest l] - -;;; *** |postMakeCons| REDEFINED - -(DEFUN |postMakeCons| (|l|) (PROG (|ISTMP#1| |ISTMP#2| |a| |l'|) (RETURN (COND ((NULL |l|) (QUOTE |nil|)) ((AND (PAIRP |l|) (PROGN (SPADLET |ISTMP#1| (QCAR |l|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#2|)) (QUOTE T)))))) (PROGN (SPADLET |l'| (QCDR |l|)) (QUOTE T))) (COND (|l'| (CONS (QUOTE |append|) (CONS (|postTran| |a|) (CONS (|postMakeCons| |l'|) NIL)))) ((QUOTE T) (|postTran| |a|)))) ((QUOTE T) (CONS (QUOTE |cons|) (CONS (|postTran| (CAR |l|)) (CONS (|postMakeCons| (CDR |l|)) NIL)))))))) - -;postBlock ['Block,:l,x] == -; ['SEQ,:postBlockItemList l,['exit,postTran x]] - -;;; *** |postBlock| REDEFINED - -(DEFUN |postBlock| (#0=#:G166455) (PROG (|LETTMP#1| |x| |l|) (RETURN (PROGN (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) (SPADLET |x| (CAR |LETTMP#1|)) (SPADLET |l| (NREVERSE (CDR |LETTMP#1|))) (CONS (QUOTE SEQ) (APPEND (|postBlockItemList| |l|) (CONS (CONS (QUOTE |exit|) (CONS (|postTran| |x|) NIL)) NIL))))))) -;postBlockItemList l == [postBlockItem x for x in l] - -;;; *** |postBlockItemList| REDEFINED - -(DEFUN |postBlockItemList| (|l|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G166476) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166481 |l| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|postBlockItem| |x|) #0#))))))))))) ;postBlockItem x == ; x:= postTran x ; x is ['Tuple,:l,[":",y,t]] and (and/[IDENTP x for x in l]) => @@ -1746,13 +1702,6 @@ parse ;;; *** SEGMENT REDEFINED (DEFUN SEGMENT (|a| |b|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G167597) (SPADLET #0# NIL) (RETURN (DO ((|i| |a| (+ |i| 1))) ((> |i| |b|) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS |i| #0#))))))))))) -;postFlattenLeft(x,op) ==-- -; x is [ =op,a,b] => [:postFlattenLeft(a,op),b] -; [x] - -;;; *** |postFlattenLeft| REDEFINED - -(DEFUN |postFlattenLeft| (|x| |op|) (PROG (|ISTMP#1| |a| |ISTMP#2| |b|) (RETURN (COND ((AND (PAIRP |x|) (EQUAL (QCAR |x|) |op|) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (APPEND (|postFlattenLeft| |a| |op|) (CONS |b| NIL))) ((QUOTE T) (CONS |x| NIL)))))) ;postSequence ['Sequence,:l] == ['(elt $ makeRecord),:postTranList l] ;;; *** |postSequence| REDEFINED