diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index cd6c718..c6e31de 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -5383,7 +5383,7 @@ of the symbol being parsed. The original list read: (loop for sig in (rest item) collect (formatSig (car item) sig)))) (dolist (term data result) - (setq result (append result item)))))) + (setq result (append result term)))))) \end{chunk} @@ -6559,6 +6559,177 @@ $\rightarrow$ \end{chunk} +\defun{augLisplibModemapsFromCategory}{augLisplibModemapsFromCategory} +\calls{augLisplibModemapsFromCategory}{sublis} +\calls{augLisplibModemapsFromCategory}{mkAlistOfExplicitCategoryOps} +\calls{augLisplibModemapsFromCategory}{isCategoryForm} +\calls{augLisplibModemapsFromCategory}{lassoc} +\calls{augLisplibModemapsFromCategory}{member} +\calls{augLisplibModemapsFromCategory}{mkpf} +\calls{augLisplibModemapsFromCategory}{interactiveModemapForm} +\refsdollar{augLisplibModemapsFromCategory}{lisplibModemapAlist} +\refsdollar{augLisplibModemapsFromCategory}{EmptyEnvironment} +\refsdollar{augLisplibModemapsFromCategory}{domainShell} +\refsdollar{augLisplibModemapsFromCategory}{PatternVariableList} +\defsdollar{augLisplibModemapsFromCategory}{lisplibModemapAlist} +\begin{chunk}{defun augLisplibModemapsFromCategory} +(DEFUN |augLisplibModemapsFromCategory| (|form| |body| |signature|) + (PROG (|argl| |sl| |opAlist| |nonCategorySigAlist| |domainList| + |catPredList| |op| |sig| |pred| |sel| |pred'| + |modemap|) + (DECLARE (SPECIAL |$lisplibModemapAlist| |$EmptyEnvironment| + |$domainShell| |$PatternVariableList|)) + (RETURN + (SEQ (PROGN + (SPADLET |op| (CAR |form|)) + (SPADLET |argl| (CDR |form|)) + (SPADLET |sl| + (CONS (CONS '$ '*1) + (PROG (G166082) + (SPADLET G166082 NIL) + (RETURN + (DO ((G166088 |argl| (CDR G166088)) + (|a| NIL) + (G166089 + (CDR |$PatternVariableList|) + (CDR G166089)) + (|p| NIL)) + ((OR (ATOM G166088) + (PROGN + (SETQ |a| (CAR G166088)) + NIL) + (ATOM G166089) + (PROGN + (SETQ |p| (CAR G166089)) + NIL)) + (NREVERSE0 G166082)) + (SEQ (EXIT + (SETQ G166082 + (CONS (CONS |a| |p|) + G166082))))))))) + (SPADLET |form| (SUBLIS |sl| |form|)) + (SPADLET |body| (SUBLIS |sl| |body|)) + (SPADLET |signature| (SUBLIS |sl| |signature|)) + (SPADLET |opAlist| + (OR (SUBLIS |sl| (ELT |$domainShell| 1)) + (RETURN NIL))) + (SPADLET |nonCategorySigAlist| + (|mkAlistOfExplicitCategoryOps| + (MSUBST '*1 '$ |body|))) + (SPADLET |domainList| + (PROG (G166104) + (SPADLET G166104 NIL) + (RETURN + (DO ((G166111 (CDR |form|) (CDR G166111)) + (|a| NIL) + (G166112 (CDR |signature|) + (CDR G166112)) + (|m| NIL)) + ((OR (ATOM G166111) + (PROGN + (SETQ |a| (CAR G166111)) + NIL) + (ATOM G166112) + (PROGN + (SETQ |m| (CAR G166112)) + NIL)) + (NREVERSE0 G166104)) + (SEQ (EXIT (COND + ((|isCategoryForm| |m| + |$EmptyEnvironment|) + (SETQ G166104 + (CONS + (CONS |a| (CONS |m| NIL)) + G166104)))))))))) + (SPADLET |catPredList| + (PROG (G166125) + (SPADLET G166125 NIL) + (RETURN + (DO ((G166130 + (CONS (CONS '*1 (CONS |form| NIL)) + |domainList|) + (CDR G166130)) + (|u| NIL)) + ((OR (ATOM G166130) + (PROGN + (SETQ |u| (CAR G166130)) + NIL)) + (NREVERSE0 G166125)) + (SEQ (EXIT (SETQ G166125 + (CONS (CONS '|ofCategory| |u|) + G166125)))))))) + (DO ((G166144 |opAlist| (CDR G166144)) (|entry| NIL)) + ((OR (ATOM G166144) + (PROGN (SETQ |entry| (CAR G166144)) NIL) + (PROGN + (PROGN + (SPADLET |op| (CAAR |entry|)) + (SPADLET |sig| (CADAR |entry|)) + (SPADLET |pred| (CADR |entry|)) + (SPADLET |sel| (CADDR |entry|)) + |entry|) + NIL)) + NIL) + (SEQ (EXIT (COND + ((|member| |sig| + (LASSOC |op| |nonCategorySigAlist|)) + (PROGN + (SPADLET |pred'| + (MKPF + (CONS |pred| |catPredList|) + 'AND)) + (SPADLET |modemap| + (CONS (CONS '*1 |sig|) + (CONS + (CONS |pred'| + (CONS |sel| NIL)) + NIL))) + (SPADLET |$lisplibModemapAlist| + (CONS + (CONS |op| + (|interactiveModemapForm| + |modemap|)) + |$lisplibModemapAlist|))))))))))))) + +;(defun |augLisplibModemapsFromCategory| (form body signature) +; (let (argl sl opAlist nonCategorySigAlist domainList catPredList op sig +; pred sel predp modemap) +; (declare (special |$lisplibModemapAlist| |$EmptyEnvironment| +; |$domainShell| |$PatternVariableList|)) +; (setq op (car form)) +; (setq argl (cdr form)) +; (setq sl +; (cons (cons '$ '*1) +; (loop for a in argl for p in (rest |$PatternVariableList|) +; collect (cons a p)))) +; (setq form (sublis sl form)) +; (setq body (sublis sl body)) +; (setq signature (sublis sl signature)) +; (when (setq opAlist (sublis sl (elt |$domainShell| 1))) +; (setq nonCategorySigAlist +; (|mkAlistOfExplicitCategoryOps| (msubst '*1 '$ body))) +; (setq domainList +; (loop for a in (rest form) for m in (rest signature) +; when (|isCategoryForm| m |$EmptyEnvironment|) +; collect (list a m))) +; (setq catPredList +; (loop for u in (cons (list '*1 form) domainList) +; collect (cons '|ofCategory| u))) +; (loop for entry in opAlist +; when (|member| (cadar entry) (lassoc (caar entry) nonCategorySigAlist)) +; do +; (setq op (caar entry)) +; (setq sig (cadar entry)) +; (setq pred (cadr entry)) +; (setq sel (caddr entry)) +; (setq predp (mkpf (cons pred catPredList) 'and)) +; (setq modemap (list (cons '*1 sig) (list predp sel))) +; (setq |$lisplibModemapAlist| +; (cons (cons op (|interactiveModemapForm| modemap)) +; |$lisplibModemapAlist|)))))) + +\end{chunk} + \defun{evalAndRwriteLispForm}{evalAndRwriteLispForm} \calls{evalAndRwriteLispForm}{eval} \calls{evalAndRwriteLispForm}{rwriteLispForm} @@ -17829,6 +18000,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun aplTran1} \getchunk{defun aplTranList} \getchunk{defun argsToSig} +\getchunk{defun augLisplibModemapsFromCategory} \getchunk{defun augModemapsFromCategory} \getchunk{defun augModemapsFromCategoryRep} \getchunk{defun augModemapsFromDomain} diff --git a/changelog b/changelog index 20b6965..38b1f9e 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20110724 tpd src/axiom-website/patches.html 20110724.01.tpd.patch +20110724 tpd src/interp/database.lisp treeshake compiler +20110724 tpd books/bookvol9 treeshake compiler 20110722 tpd src/axiom-website/patches.html 20110722.01.tpd.patch 20110722 tpd src/interp/lisplib.lisp treeshake compiler 20110722 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 4f2fdbf..f1ec2a2 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3552,5 +3552,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20110722.01.tpd.patch books/bookvol9 treeshake compiler
+20110724.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/database.lisp.pamphlet b/src/interp/database.lisp.pamphlet index 3cdd82e..99b3f3a 100644 --- a/src/interp/database.lisp.pamphlet +++ b/src/interp/database.lisp.pamphlet @@ -14,145 +14,6 @@ (SETANDFILEQ |$getUnexposedOperations| 'T) -;--% Functions for manipulating MODEMAP DATABASE -;augLisplibModemapsFromCategory(form is [op,:argl],body,signature) == -; sl := [["$",:"*1"],:[[a,:p] for a in argl -; for p in rest $PatternVariableList]] -; form:= SUBLIS(sl,form) -; body:= SUBLIS(sl,body) -; signature:= SUBLIS(sl,signature) -; opAlist:= SUBLIS(sl,$domainShell.(1)) or return nil -; nonCategorySigAlist:= -; mkAlistOfExplicitCategoryOps substitute("*1","$",body) -; domainList:= -; [[a,m] for a in rest form for m in rest signature | -; isCategoryForm(m,$EmptyEnvironment)] -; catPredList:= [['ofCategory,:u] for u in [["*1",form],:domainList]] -; for (entry:= [[op,sig,:.],pred,sel]) in opAlist | -; MEMBER(sig,LASSOC(op,nonCategorySigAlist)) repeat -; pred':= MKPF([pred,:catPredList],'AND) -; modemap:= [["*1",:sig],[pred',sel]] -; $lisplibModemapAlist:= -; [[op,:interactiveModemapForm modemap],:$lisplibModemapAlist] - -(DEFUN |augLisplibModemapsFromCategory| (|form| |body| |signature|) - (PROG (|argl| |sl| |opAlist| |nonCategorySigAlist| |domainList| - |catPredList| |op| |sig| |pred| |sel| |pred'| - |modemap|) - (DECLARE (SPECIAL |$lisplibModemapAlist| |$EmptyEnvironment| - |$domainShell| |$PatternVariableList|)) - (RETURN - (SEQ (PROGN - (SPADLET |op| (CAR |form|)) - (SPADLET |argl| (CDR |form|)) - (SPADLET |sl| - (CONS (CONS '$ '*1) - (PROG (G166082) - (SPADLET G166082 NIL) - (RETURN - (DO ((G166088 |argl| (CDR G166088)) - (|a| NIL) - (G166089 - (CDR |$PatternVariableList|) - (CDR G166089)) - (|p| NIL)) - ((OR (ATOM G166088) - (PROGN - (SETQ |a| (CAR G166088)) - NIL) - (ATOM G166089) - (PROGN - (SETQ |p| (CAR G166089)) - NIL)) - (NREVERSE0 G166082)) - (SEQ (EXIT - (SETQ G166082 - (CONS (CONS |a| |p|) - G166082))))))))) - (SPADLET |form| (SUBLIS |sl| |form|)) - (SPADLET |body| (SUBLIS |sl| |body|)) - (SPADLET |signature| (SUBLIS |sl| |signature|)) - (SPADLET |opAlist| - (OR (SUBLIS |sl| (ELT |$domainShell| 1)) - (RETURN NIL))) - (SPADLET |nonCategorySigAlist| - (|mkAlistOfExplicitCategoryOps| - (MSUBST '*1 '$ |body|))) - (SPADLET |domainList| - (PROG (G166104) - (SPADLET G166104 NIL) - (RETURN - (DO ((G166111 (CDR |form|) (CDR G166111)) - (|a| NIL) - (G166112 (CDR |signature|) - (CDR G166112)) - (|m| NIL)) - ((OR (ATOM G166111) - (PROGN - (SETQ |a| (CAR G166111)) - NIL) - (ATOM G166112) - (PROGN - (SETQ |m| (CAR G166112)) - NIL)) - (NREVERSE0 G166104)) - (SEQ (EXIT (COND - ((|isCategoryForm| |m| - |$EmptyEnvironment|) - (SETQ G166104 - (CONS - (CONS |a| (CONS |m| NIL)) - G166104)))))))))) - (SPADLET |catPredList| - (PROG (G166125) - (SPADLET G166125 NIL) - (RETURN - (DO ((G166130 - (CONS (CONS '*1 (CONS |form| NIL)) - |domainList|) - (CDR G166130)) - (|u| NIL)) - ((OR (ATOM G166130) - (PROGN - (SETQ |u| (CAR G166130)) - NIL)) - (NREVERSE0 G166125)) - (SEQ (EXIT (SETQ G166125 - (CONS (CONS '|ofCategory| |u|) - G166125)))))))) - (DO ((G166144 |opAlist| (CDR G166144)) (|entry| NIL)) - ((OR (ATOM G166144) - (PROGN (SETQ |entry| (CAR G166144)) NIL) - (PROGN - (PROGN - (SPADLET |op| (CAAR |entry|)) - (SPADLET |sig| (CADAR |entry|)) - (SPADLET |pred| (CADR |entry|)) - (SPADLET |sel| (CADDR |entry|)) - |entry|) - NIL)) - NIL) - (SEQ (EXIT (COND - ((|member| |sig| - (LASSOC |op| |nonCategorySigAlist|)) - (PROGN - (SPADLET |pred'| - (MKPF - (CONS |pred| |catPredList|) - 'AND)) - (SPADLET |modemap| - (CONS (CONS '*1 |sig|) - (CONS - (CONS |pred'| - (CONS |sel| NIL)) - NIL))) - (SPADLET |$lisplibModemapAlist| - (CONS - (CONS |op| - (|interactiveModemapForm| - |modemap|)) - |$lisplibModemapAlist|))))))))))))) - ;augmentLisplibModemapsFromFunctor(form,opAlist,signature) == ; form:= [formOp,:argl]:= formal2Pattern form ; opAlist:= formal2Pattern opAlist