diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 6af1a5b..bb71ebd 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -1924,6 +1924,95 @@ preferred to the underlying representation -- RDJ 9/12/83 (|compToApply| op argl m e))))))) @ + +\defun{compForm2}{compForm2} +\calls{compForm2}{take} +\calls{compForm2}{length} +\calls{compForm2}{nreverse0} +\calls{compForm2}{sublis} +\calls{compForm2}{assoc} +\calls{compForm2}{PredImplies} +\calls{compForm2}{isSimple} +\calls{compForm2}{compUniquely} +\calls{compForm2}{compFormPartiallyBottomUp} +\calls{compForm2}{compForm3} +\usesdollar{compForm2}{EmptyMode} +\usesdollar{compForm2}{TriangleVariableList} +<>= +(defun |compForm2| (form m e modemapList) + (let (op argl sargl aList dc cond nsig v ncond deleteList newList td tl + partialModeList tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 tmp7 tmp8 tmp9 tmpb tmpc) + (declare (special |$EmptyMode| |$TriangleVariableList|)) + (setq op (car form)) + (setq argl (cdr form)) + (setq sargl (take (|#| argl) |$TriangleVariableList|)) + (setq aList (mapcar #'(lambda (x y) (cons x y)) sargl argl)) + (setq modemaplist (sublis aList modemapList)) + ; now delete any modemaps that are subsumed by something else, provided + ; the conditions are right (i.e. subsumer true whenever subsumee true) + (dolist (u modemapList) + (cond + ((and (pairp u) + (progn + (setq tmp6 (qcar u)) + (and (pairp tmp6) (progn (setq dc (qcar tmp6)) t))) + (progn + (setq tmp7 (qcdr u)) + (and (pairp tmp7) (eq (qcdr tmp7) nil) + (progn + (setq tmp1 (qcar tmp7)) + (and (pairp tmp1) + (progn + (setq cond (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and (pairp tmp2) (eq (qcdr tmp2) nil) + (progn + (setq tmp3 (qcar tmp2)) + (and (pairp tmp3) (eq (qcar tmp3) '|Subsumed|) + (progn + (setq tmp4 (qcdr tmp3)) + (and (pairp tmp4) + (progn + (setq tmp5 (qcdr tmp4)) + (and (pairp tmp5) + (eq (qcdr tmp5) nil) + (progn + (setq nsig (qcar tmp5)) + t))))))))))))) + (setq v (|assoc| (cons dc nsig) modemapList)) + (pairp v) + (progn + (setq tmp6 (qcdr v)) + (and (pairp tmp6) (eq (qcdr tmp6) nil) + (progn + (setq tmp7 (qcar tmp6)) + (and (pairp tmp7) + (progn + (setq ncond (qcar tmp7)) + t)))))) + (setq deleteList (cons u deleteList)) + (unless (|PredImplies| ncond cond) + (setq newList (push `(,(car u) (,cond (elt ,dc nil))) newList)))))) + (when deleteList + (setq modemapList + (remove-if #'(lambda (x) (member x deletelist)) modemapList))) + ; it is important that subsumed ops (newList) be considered last + (when newList (setq modemapList (append modemapList newList))) + (setq tl + (loop for x in argl + while (and (|isSimple| x) + (setq td (|compUniquely| x |$EmptyMode| e))) + collect td + do (setq e (third td)))) + (cond + ((some #'identity tl) + (setq partialModeList (loop for x in tl collect (when x (second x)))) + (or (|compFormPartiallyBottomUp| form m e modemapList partialModeList) + (|compForm3| form m e modemapList))) + (t (|compForm3| form m e modemapList))))) + +@ + \defun{compArgumentsAndTryAgain}{compArgumentsAndTryAgain} \calls{compArgumentsAndTryAgain}{comp} \calls{compArgumentsAndTryAgain}{compForm1} @@ -2402,11 +2491,10 @@ preferred to the underlying representation -- RDJ 9/12/83 (list '@ (list '+-> arg1 body) (cons '|Mapping| (cons target sig1))) m e)) - (format t "TPDHERE4~%") ress) - (t (format t "TPDHERE1~%") (|stackAndThrow| (list '|compLambda| x ))))) - (t (format t "TPDHERE2~%") (|stackAndThrow| (list '|compLambda| x ))))) - (t (format t "TPDHERE3~%") (|stackAndThrow| (list '|compLambda| x )))))) + (t (|stackAndThrow| (list '|compLambda| x ))))) + (t (|stackAndThrow| (list '|compLambda| x ))))) + (t (|stackAndThrow| (list '|compLambda| x )))))) @ @@ -2746,6 +2834,7 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 0c974b8..fd90cc9 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20100919 tpd src/axiom-website/patches.html 20100919.02.tpd.patch +20100919 tpd src/interp/compiler.lisp treeshake compiler +20100919 tpd books/bookvol9 treeshake compiler 20100919 tpd src/axiom-website/patches.html 20100919.01.tpd.patch 20100919 tpd src/interp/compiler.lisp treeshake compiler 20100919 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index a6ef8a4..9580227 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3129,5 +3129,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20100919.01.tpd.patch books/bookvol9 treeshake compiler
+20100919.02.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/compiler.lisp.pamphlet b/src/interp/compiler.lisp.pamphlet index 88e6b33..a705b10 100644 --- a/src/interp/compiler.lisp.pamphlet +++ b/src/interp/compiler.lisp.pamphlet @@ -269,232 +269,6 @@ |m|)))))))) @ -\subsection{compForm2} -<<*>>= -;compForm2(form is [op,:argl],m,e,modemapList) == -; sargl:= TAKE(# argl, $TriangleVariableList) -; aList:= [[sa,:a] for a in argl for sa in sargl] -; modemapList:= SUBLIS(aList,modemapList) -; deleteList:=[] -; newList := [] -; -- now delete any modemaps that are subsumed by something else, provided the conditions -; -- are right (i.e. subsumer true whenever subsumee true) -; for u in modemapList repeat -; if u is [[dc,:.],[cond,["Subsumed",.,nsig]]] and -; (v:=assoc([dc,:nsig],modemapList)) and v is [.,[ncond,:.]] then -; deleteList:=[u,:deleteList] -; if not PredImplies(ncond,cond) then -; newList := [[CAR u,[cond,['ELT,dc,nil]]],:newList] -; if deleteList then modemapList:=[u for u in modemapList | not MEMQ(u,deleteList)] -; -- We can use MEMQ since deleteList was built out of members of modemapList -; -- its important that subsumed ops (newList) be considered last -; if newList then modemapList := append(modemapList,newList) -; Tl:= -; [[.,.,e]:= T -; for x in argl while (isSimple x and (T:= compUniquely(x,$EmptyMode,e)))] -; or/[x for x in Tl] => -; partialModeList:= [(x => x.mode; nil) for x in Tl] -; compFormPartiallyBottomUp(form,m,e,modemapList,partialModeList) or -; compForm3(form,m,e,modemapList) -; compForm3(form,m,e,modemapList) - -(DEFUN |compForm2| (|form| |m| |e| |modemapList|) - (PROG (|op| |argl| |sargl| |aList| |dc| |ISTMP#3| |cond| |ISTMP#4| - |ISTMP#5| |ISTMP#6| |ISTMP#7| |nsig| |v| |ISTMP#1| |ISTMP#2| - |ncond| |deleteList| |newList| T$ |Tl| |partialModeList|) - (declare (special |$EmptyMode| |$TriangleVariableList|)) - (RETURN - (SEQ (PROGN - (SPADLET |op| (CAR |form|)) - (SPADLET |argl| (CDR |form|)) - (SPADLET |sargl| - (TAKE (|#| |argl|) |$TriangleVariableList|)) - (SPADLET |aList| - (PROG (G167385) - (SPADLET G167385 NIL) - (RETURN - (DO ((G167391 |argl| (CDR G167391)) - (|a| NIL) - (G167392 |sargl| (CDR G167392)) - (|sa| NIL)) - ((OR (ATOM G167391) - (PROGN - (SETQ |a| (CAR G167391)) - NIL) - (ATOM G167392) - (PROGN - (SETQ |sa| (CAR G167392)) - NIL)) - (NREVERSE0 G167385)) - (SEQ (EXIT (SETQ G167385 - (CONS (CONS |sa| |a|) - G167385)))))))) - (SPADLET |modemapList| (SUBLIS |aList| |modemapList|)) - (SPADLET |deleteList| NIL) - (SPADLET |newList| NIL) - (DO ((G167429 |modemapList| (CDR G167429)) (|u| NIL)) - ((OR (ATOM G167429) - (PROGN (SETQ |u| (CAR G167429)) NIL)) - NIL) - (SEQ (EXIT (COND - ((AND (PAIRP |u|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |u|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |dc| (QCAR |ISTMP#1|)) - 'T))) - (PROGN - (SPADLET |ISTMP#2| (QCDR |u|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |ISTMP#3| - (QCAR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (PROGN - (SPADLET |cond| - (QCAR |ISTMP#3|)) - (SPADLET |ISTMP#4| - (QCDR |ISTMP#3|)) - (AND (PAIRP |ISTMP#4|) - (EQ (QCDR |ISTMP#4|) NIL) - (PROGN - (SPADLET |ISTMP#5| - (QCAR |ISTMP#4|)) - (AND (PAIRP |ISTMP#5|) - (EQ (QCAR |ISTMP#5|) - '|Subsumed|) - (PROGN - (SPADLET |ISTMP#6| - (QCDR |ISTMP#5|)) - (AND (PAIRP |ISTMP#6|) - (PROGN - (SPADLET |ISTMP#7| - (QCDR |ISTMP#6|)) - (AND - (PAIRP |ISTMP#7|) - (EQ - (QCDR |ISTMP#7|) - NIL) - (PROGN - (SPADLET |nsig| - (QCAR |ISTMP#7|)) - 'T))))))))))))) - (SPADLET |v| - (|assoc| (CONS |dc| |nsig|) - |modemapList|)) - (PAIRP |v|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |v|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| - (QCAR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |ncond| - (QCAR |ISTMP#2|)) - 'T)))))) - (SPADLET |deleteList| - (CONS |u| |deleteList|)) - (COND - ((NULL (|PredImplies| |ncond| |cond|)) - (SPADLET |newList| - (CONS - (CONS (CAR |u|) - (CONS - (CONS |cond| - (CONS - (CONS 'ELT - (CONS |dc| - (CONS NIL NIL))) - NIL)) - NIL)) - |newList|))) - ('T NIL))) - ('T NIL))))) - (COND - (|deleteList| - (SPADLET |modemapList| - (PROG (G167440) - (SPADLET G167440 NIL) - (RETURN - (DO ((G167446 |modemapList| - (CDR G167446)) - (|u| NIL)) - ((OR (ATOM G167446) - (PROGN - (SETQ |u| (CAR G167446)) - NIL)) - (NREVERSE0 G167440)) - (SEQ (EXIT - (COND - ((NULL - (member |u| |deleteList|)) - (SETQ G167440 - (CONS |u| G167440)))))))))))) - (COND - (|newList| - (SPADLET |modemapList| - (APPEND |modemapList| |newList|)))) - (SPADLET |Tl| - (PROG (G167459) - (SPADLET G167459 NIL) - (RETURN - (DO ((G167467 |argl| (CDR G167467)) - (|x| NIL)) - ((OR (ATOM G167467) - (PROGN - (SETQ |x| (CAR G167467)) - NIL) - (NULL - (AND (|isSimple| |x|) - (SPADLET T$ - (|compUniquely| |x| |$EmptyMode| - |e|))))) - (NREVERSE0 G167459)) - (SEQ (EXIT (SETQ G167459 - (CONS - (PROGN - (SPADLET |e| (CADDR T$)) - T$) - G167459)))))))) - (COND - ((PROG (G167474) - (SPADLET G167474 NIL) - (RETURN - (DO ((G167480 NIL G167474) - (G167481 |Tl| (CDR G167481)) (|x| NIL)) - ((OR G167480 (ATOM G167481) - (PROGN (SETQ |x| (CAR G167481)) NIL)) - G167474) - (SEQ (EXIT (SETQ G167474 (OR G167474 |x|))))))) - (SPADLET |partialModeList| - (PROG (G167492) - (SPADLET G167492 NIL) - (RETURN - (DO ((G167497 |Tl| (CDR G167497)) - (|x| NIL)) - ((OR (ATOM G167497) - (PROGN - (SETQ |x| (CAR G167497)) - NIL)) - (NREVERSE0 G167492)) - (SEQ (EXIT - (SETQ G167492 - (CONS - (COND - (|x| (CADR |x|)) - ('T NIL)) - G167492)))))))) - (OR (|compFormPartiallyBottomUp| |form| |m| |e| - |modemapList| |partialModeList|) - (|compForm3| |form| |m| |e| |modemapList|))) - ('T (|compForm3| |form| |m| |e| |modemapList|)))))))) - -@ \subsection{compFormPartiallyBottomUp} <<*>>= ;compFormPartiallyBottomUp(form,m,e,modemapList,partialModeList) ==