diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 4a608b5..f49c843 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -8191,6 +8191,31 @@ of the symbol being parsed. The original list read: \end{chunk} +\defun{postType}{postType} +\calls{postType}{postTran} +\calls{postType}{unTuple} +\begin{chunk}{defun postType} +(defun |postType| (typ) + (let (source target) + (cond + ((and (pairp typ) (eq (qcar typ) '->) (pairp (qcdr typ)) + (pairp (qcdr (qcdr typ))) (eq (qcdr (qcdr (qcdr typ))) nil)) + (setq source (qcar (qcdr typ))) + (setq target (qcar (qcdr (qcdr typ)))) + (cond + ((eq source '|constant|) + (list (list (|postTran| target)) '|constant|)) + (t + (list (cons '|Mapping| + (cons (|postTran| target) + (|unTuple| (|postTran| source)))))))) + ((and (pairp typ) (eq (qcar typ) '->) + (pairp (qcdr typ)) (eq (qcdr (qcdr typ)) nil)) + (list (list '|Mapping| (|postTran| (qcar (qcdr typ)))))) + (t (list (|postTran| typ)))))) + +\end{chunk} + \defplist{:BF:}{postBigFloat} \begin{chunk}{postvars} (eval-when (eval load) @@ -8355,6 +8380,36 @@ of the symbol being parsed. The original list read: \end{chunk} +\defun{postIteratorList}{postIteratorList} +\calls{postIteratorList}{postTran} +\calls{postIteratorList}{postInSeq} +\calls{postIteratorList}{postIteratorList} +\begin{chunk}{defun postIteratorList} +(defun |postIteratorList| (args) + (let (z p y u a b) + (cond + ((pairp args) + (setq p (|postTran| (qcar args))) + (setq z (qcdr args)) + (cond + ((and (pairp p) (eq (qcar p) 'in) (pairp (qcdr p)) + (pairp (qcdr (qcdr p))) (eq (qcdr (qcdr (qcdr p))) nil)) + (setq y (qcar (qcdr p))) + (setq u (qcar (qcdr (qcdr p)))) + (cond + ((and (pairp u) (eq (qcar u) '|\||) (pairp (qcdr u)) + (pairp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil)) + (setq a (qcar (qcdr u))) + (setq b (qcar (qcdr (qcdr u)))) + (cons (list 'in y (|postInSeq| a)) + (cons (list '|\|| b) + (|postIteratorList| z)))) + (t (cons (list 'in y (|postInSeq| u)) (|postIteratorList| z))))) + (t (cons p (|postIteratorList| z))))) + (t args)))) + +\end{chunk} + \defplist{:}{postColon} \begin{chunk}{postvars} (eval-when (eval load) @@ -8562,6 +8617,30 @@ of the symbol being parsed. The original list read: \end{chunk} +\defun{postDefArgs}{postDefArgs} +\calls{postDefArgs}{postError} +\calls{postDefArgs}{postDefArgs} +\begin{chunk}{defun postDefArgs} +(defun |postDefArgs| (args) + (let (a b) + (cond + ((null args) args) + ((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)) + (cond + (b (|postError| + (list " Argument" a "of indefinite length must be last"))) + ((or (atom a) (and (pairp a) (eq (qcar a) 'quote))) + a) + (t + (|postError| + (list " Argument" a "of indefinite length must be a name"))))) + (t (cons (car args) (|postDefArgs| (cdr args))))))) + +\end{chunk} + \defplist{$=>$}{postExit} \begin{chunk}{postvars} (eval-when (eval load) @@ -8623,6 +8702,22 @@ of the symbol being parsed. The original list read: \end{chunk} +\defun{postInSeq}{postInSeq} +\calls{postInSeq}{postTranSegment} +\calls{postInSeq}{tuple2List} +\calls{postInSeq}{postTran} +\begin{chunk}{defun postInSeq} +(defun |postInSeq| (seq) + (cond + ((and (pairp seq) (eq (qcar seq) 'segment) (pairp (qcdr seq)) + (pairp (qcdr (qcdr seq))) (eq (qcdr (qcdr (qcdr seq))) nil)) + (|postTranSegment| (second seq) (third seq))) + ((and (pairp seq) (eq (qcar seq) '|@Tuple|)) + (|tuple2List| (qcdr seq))) + (t (|postTran| seq)))) + +\end{chunk} + \defplist{In}{postIn} \begin{chunk}{postvars} (eval-when (eval load) @@ -14768,11 +14863,14 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun postComma} \getchunk{defun postConstruct} \getchunk{defun postDef} +\getchunk{defun postDefArgs} \getchunk{defun postError} \getchunk{defun postExit} \getchunk{defun postIf} \getchunk{defun postin} \getchunk{defun postIn} +\getchunk{defun postInSeq} +\getchunk{defun postIteratorList} \getchunk{defun postJoin} \getchunk{defun postMapping} \getchunk{defun postMDef} @@ -14794,6 +14892,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun postTransformCheck} \getchunk{defun postTuple} \getchunk{defun postTupleCollect} +\getchunk{defun postType} \getchunk{defun postWhere} \getchunk{defun postWith} \getchunk{defun preparse} diff --git a/changelog b/changelog index d33e9ab..ccdaac4 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20110301 tpd src/axiom-website/patches.html 20110301.04.tpd.patch +20110301 tpd src/interp/parsing.lisp treeshake compiler +20110301 tpd books/bookvol9 treeshake compiler 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 diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 7d469f7..1848530 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3421,5 +3421,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20110301.03.tpd.patch books/bookvol9 treeshake compiler
+20110301.04.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index a0276ef..0d491d5 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -1610,19 +1610,6 @@ parse ;;; *** |postBlockItem| REDEFINED (DEFUN |postBlockItem| (|x|) (PROG (|ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |y| |ISTMP#5| |t| |l|) (RETURN (SEQ (PROGN (SPADLET |x| (|postTran| |x|)) (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |@Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (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=#:G166534) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G166540 NIL (NULL #0#)) (#2=#:G166541 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (IDENTP |x|))))))))) (CONS (QUOTE |:|) (CONS (CONS (QUOTE LISTOF) (APPEND |l| (CONS |y| NIL))) (CONS |t| NIL)))) ((QUOTE T) |x|))))))) -;postDefArgs argl == -; null argl => argl -; argl is [[":",a],:b] => -; b => postError -; ['" Argument",:bright a,'"of indefinite length must be last"] -; atom a or a is ['QUOTE,:.] => a -; postError -; ['" Argument",:bright a,'"of indefinite length must be a name"] -; [first argl,:postDefArgs rest argl] - -;;; *** |postDefArgs| REDEFINED - -(DEFUN |postDefArgs| (|argl|) (PROG (|ISTMP#1| |ISTMP#2| |a| |b|) (RETURN (COND ((NULL |argl|) |argl|) ((AND (PAIRP |argl|) (PROGN (SPADLET |ISTMP#1| (QCAR |argl|)) (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 |b| (QCDR |argl|)) (QUOTE T))) (COND (|b| (|postError| (CONS " Argument" (APPEND (|bright| |a|) (CONS "of indefinite length must be last" NIL))))) ((OR (ATOM |a|) (AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE QUOTE)))) |a|) ((QUOTE T) (|postError| (CONS " Argument" (APPEND (|bright| |a|) (CONS "of indefinite length must be a name" NIL))))))) ((QUOTE T) (CONS (CAR |argl|) (|postDefArgs| (CDR |argl|)))))))) ;postElt (u is [.,a,b]) == ; a:= postTran a ; b is ['Sequence,:.] => [['elt,a,'makeRecord],:postTranList rest b] @@ -1678,25 +1665,6 @@ parse ; ['REDUCE,'append,0,[op,:itl,newBody]] ; [op,:itl,y] -;postIteratorList x == -; x is [p,:l] => -; (p:= postTran p) is ['IN,y,u] => -; u is ["|",a,b] => [['IN,y,postInSeq a],["|",b],:postIteratorList l] -; [['IN,y,postInSeq u],:postIteratorList l] -; [p,:postIteratorList l] -; x - -;;; *** |postIteratorList| REDEFINED - -(DEFUN |postIteratorList| (|x|) (PROG (|l| |p| |y| |ISTMP#3| |u| |ISTMP#1| |a| |ISTMP#2| |b|) (RETURN (COND ((AND (PAIRP |x|) (PROGN (SPADLET |p| (QCAR |x|)) (SPADLET |l| (QCDR |x|)) (QUOTE T))) (COND ((PROGN (SPADLET |ISTMP#1| (SPADLET |p| (|postTran| |p|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE IN)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |u| (QCAR |ISTMP#3|)) (QUOTE T)))))))) (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |\||)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (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))))))) (CONS (CONS (QUOTE IN) (CONS |y| (CONS (|postInSeq| |a|) NIL))) (CONS (CONS (QUOTE |\||) (CONS |b| NIL)) (|postIteratorList| |l|)))) ((QUOTE T) (CONS (CONS (QUOTE IN) (CONS |y| (CONS (|postInSeq| |u|) NIL))) (|postIteratorList| |l|))))) ((QUOTE T) (CONS |p| (|postIteratorList| |l|))))) ((QUOTE T) |x|))))) -;postInSeq seq == -; seq is ['SEGMENT,p,q] => postTranSegment(p,q) -; seq is ['Tuple,:l] => tuple2List l -; postTran seq - -;;; *** |postInSeq| REDEFINED - -(DEFUN |postInSeq| (|seq|) (PROG (|ISTMP#1| |p| |ISTMP#2| |q| |l|) (RETURN (COND ((AND (PAIRP |seq|) (EQ (QCAR |seq|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |seq|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (|postTranSegment| |p| |q|)) ((AND (PAIRP |seq|) (EQ (QCAR |seq|) (QUOTE |@Tuple|)) (PROGN (SPADLET |l| (QCDR |seq|)) (QUOTE T))) (|tuple2List| |l|)) ((QUOTE T) (|postTran| |seq|)))))) ;SEGMENT(a,b) == [i for i in a..b] ;;; *** SEGMENT REDEFINED @@ -1726,16 +1694,6 @@ parse ;;; *** |removeSuperfluousMapping| REDEFINED (DEFUN |removeSuperfluousMapping| (|sig1|) (PROG (|x| |y|) (RETURN (COND ((AND (PAIRP |sig1|) (PROGN (SPADLET |x| (QCAR |sig1|)) (SPADLET |y| (QCDR |sig1|)) (QUOTE T)) (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Mapping|))) (CONS (CDR |x|) |y|)) ((QUOTE T) |sig1|))))) -;postType typ == -; typ is ["->",source,target] => -; source="constant" => [LIST postTran target,"constant"] -; LIST ['Mapping,postTran target,:unTuple postTran source] -; typ is ["->",target] => LIST ['Mapping,postTran target] -; LIST postTran typ - -;;; *** |postType| REDEFINED - -(DEFUN |postType| (|typ|) (PROG (|source| |ISTMP#2| |ISTMP#1| |target|) (RETURN (COND ((AND (PAIRP |typ|) (EQ (QCAR |typ|) (QUOTE ->)) (PROGN (SPADLET |ISTMP#1| (QCDR |typ|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |source| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |target| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((BOOT-EQUAL |source| (QUOTE |constant|)) (CONS (LIST (|postTran| |target|)) (CONS (QUOTE |constant|) NIL))) ((QUOTE T) (LIST (CONS (QUOTE |Mapping|) (CONS (|postTran| |target|) (|unTuple| (|postTran| |source|)))))))) ((AND (PAIRP |typ|) (EQ (QCAR |typ|) (QUOTE ->)) (PROGN (SPADLET |ISTMP#1| (QCDR |typ|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |target| (QCAR |ISTMP#1|)) (QUOTE T))))) (LIST (CONS (QUOTE |Mapping|) (CONS (|postTran| |target|) NIL)))) ((QUOTE T) (LIST (|postTran| |typ|))))))) ;--u is ['Tuple,:l,a] => (--a:= postTran a; ['Tuple,:postTranList rest u]) ; --RDJ: don't understand need for above statement that is commented out ;isPackageType x == not CONTAINED("$",x)