diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet
index 87601f9..038128f 100644
--- a/books/bookvol9.pamphlet
+++ b/books/bookvol9.pamphlet
@@ -10426,6 +10426,101 @@ The way XLAMs work:
\end{chunk}
+\defun{compMapCond}{compMapCond}
+\calls{compMapCond}{compMapCond'}
+\refsdollar{compMapCond}{bindings}
+\begin{chunk}{defun compMapCond}
+(defun |compMapCond| (op mc |$bindings| fnsel)
+ (declare (special |$bindings|))
+ (let (t0)
+ (do ((t1 nil t0) (t2 fnsel (cdr t2)) (u nil))
+ ((or t1 (atom t2) (progn (setq u (car t2)) nil)) t0)
+ (setq t0 (or t0 (|compMapCond'| u op mc |$bindings|))))))
+
+\end{chunk}
+
+\defun{compMapCond'}{compMapCond'}
+\calls{compMapCond'}{compMapCond''}
+\calls{compMapCond'}{compMapConfFun}
+\calls{compMapCond'}{stackMessage}
+\begin{chunk}{defun compMapCond'}
+(defun |compMapCond'| (t0 op dc bindings)
+ (let ((cexpr (car t0)) (fnexpr (cadr t0)))
+ (if (|compMapCond''| cexpr dc)
+ (|compMapCondFun| fnexpr op dc bindings)
+ (|stackMessage| `("not known that" %b ,dc %d "has" %b ,cexpr %d)))))
+
+\end{chunk}
+
+\defun{compMapCond''}{compMapCond''}
+\calls{compMapCond''}{compMapCond''}
+\calls{compMapCond''}{knownInfo}
+\calls{compMapCond''}{get}
+\calls{compMapCond''}{stackMessage}
+\refsdollar{compMapCond''}{Information}
+\refsdollar{compMapCond''}{e}
+\begin{chunk}{defun compMapCond''}
+(defun |compMapCond''| (cexpr dc)
+ (let (l u tmp1 tmp2)
+ (declare (special |$Information| |$e|))
+ (cond
+ ((eq cexpr t) t)
+ ((and (consp cexpr)
+ (eq (qcar cexpr) 'and)
+ (progn (setq l (qcdr cexpr)) t))
+ (prog (t0)
+ (setq t0 t)
+ (return
+ (do ((t1 nil (null t0)) (t2 l (cdr t2)) (u nil))
+ ((or t1 (atom t2) (progn (setq u (car t2)) nil)) t0)
+ (setq t0 (and t0 (|compMapCond''| u dc)))))))
+ ((and (consp cexpr)
+ (eq (qcar cexpr) 'or)
+ (progn (setq l (qcdr cexpr)) t))
+ (prog (t3)
+ (setq t3 nil)
+ (return
+ (do ((t4 nil t3) (t5 l (cdr t5)) (u nil))
+ ((or t4 (atom t5) (progn (setq u (car t5)) nil)) t3)
+ (setq t3 (or t3 (|compMapCond''| u dc)))))))
+ ((and (consp cexpr)
+ (eq (qcar cexpr) '|not|)
+ (progn
+ (setq tmp1 (qcdr cexpr))
+ (and (consp tmp1)
+ (eq (qcdr tmp1) nil)
+ (progn (setq u (qcar tmp1)) t))))
+ (null (|compMapCond''| u dc)))
+ ((and (consp cexpr)
+ (eq (qcar cexpr) '|has|)
+ (progn
+ (setq tmp1 (qcdr cexpr))
+ (and (consp tmp1)
+ (progn
+ (setq tmp2 (qcdr tmp1))
+ (and (consp tmp2)
+ (eq (qcdr tmp2) nil))))))
+ (cond
+ ((|knownInfo| cexpr) t)
+ (t nil)))
+ ((|member|
+ (cons 'attribute (cons dc (cons cexpr nil)))
+ (|get| '|$Information| 'special |$e|))
+ t)
+ (t
+ (|stackMessage| `("not known that" %b ,dc %d "has" %b ,cexpr %d))
+ nil))))
+
+\end{chunk}
+
+\defun{compMapCondFun}{compMapCondFun}
+\begin{chunk}{defun compMapCondFun}
+(defun |compMapCondFun| (fnexpr op dc bindings)
+ (declare (ignore op) (ignore dc))
+ (cons fnexpr (cons bindings nil)))
+
+\end{chunk}
+
\defun{getUniqueSignature}{getUniqueSignature}
\calls{getUniqueSignature}{getUniqueModemap}
\begin{chunk}{defun getUniqueSignature}
@@ -21088,6 +21183,76 @@ preferred to the underlying representation -- RDJ 9/12/83
\end{chunk}
+\defun{applyMapping}{applyMapping}
+\calls{applyMapping}{nequal}
+\calls{applyMapping}{isCategoryForm}
+\calls{applyMapping}{sublis}
+\calls{applyMapping}{comp}
+\calls{applyMapping}{convert}
+\calls{applyMapping}{member}
+\calls{applyMapping}{get}
+\calls{applyMapping}{getAbbreviation}
+\calls{applyMapping}{encodeItem}
+\refsdollar{applyMapping}{FormalMapVariableList}
+\refsdollar{applyMapping}{form}
+\refsdollar{applyMapping}{op}
+\refsdollar{applyMapping}{prefix}
+\refsdollar{applyMapping}{formalArgList}
+\begin{chunk}{defun applyMapping}
+(defun |applyMapping| (t0 m e ml)
+ (prog (op argl mlp temp1 arglp nprefix opp form pairlis)
+ (declare (special |$FormalMapVariableList| |$form| |$op| |$prefix|
+ |$formalArgList|))
+ (return
+ (progn
+ (setq op (car t0))
+ (setq argl (cdr t0))
+ (cond
+ ((nequal (|#| argl) (1- (|#| ml))) nil)
+ ((|isCategoryForm| (car ml) e)
+ (setq pairlis
+ (loop for a in argl for v in |$FormalMapVariableList|
+ collect (cons v a)))
+ (setq mlp (sublis pairlis ml))
+ (setq arglp
+ (loop for x in argl for mp in (rest mlp)
+ collect (car
+ (progn
+ (setq temp1 (or (|comp| x mp e) (return '|failed|)))
+ (setq e (caddr temp1))
+ temp1))))
+ (when (eq arglp '|failed|) (return nil))
+ (setq form (cons op arglp))
+ (|convert| (list form (car mlp) e) m))
+ (t
+ (setq arglp
+ (loop for x in argl for mp in (rest ml)
+ collect (car
+ (progn
+ (setq temp1 (or (|comp| x mp e) (return '|failed|)))
+ (setq e (caddr temp1))
+ temp1))))
+ (when (eq arglp '|failed|) (return nil))
+ (setq form
+ (cond
+ ((and (null (|member| op |$formalArgList|))
+ (atom op)
+ (null (|get| op '|value| e)))
+ (setq nprefix
+ (or |$prefix| (|getAbbreviation| |$op| (|#| (cdr |$form|)))))
+ (setq opp
+ (intern (strconc
+ (|encodeItem| nprefix) '|;| (|encodeItem| op))))
+ (cons opp (append arglp (list '$))))
+ (t
+ (cons '|call| (cons (list '|applyFun| op) arglp)))))
+ (setq pairlis
+ (loop for a in arglp for v in |$FormalMapVariableList|
+ collect (cons v a)))
+ (|convert| (list form (sublis pairlis (car ml)) e) m)))))))
+
+\end{chunk}
+
\defun{compApply}{compApply}
\calls{compApply}{comp}
\calls{compApply}{Pair}
@@ -21274,6 +21439,17 @@ preferred to the underlying representation -- RDJ 9/12/83
\end{chunk}
+\defun{transImplementation}{transImplementation}
+\calls{transImplementation}{genDeltaEntry}
+\begin{chunk}{defun transImplementation}
+(defun |transImplementation| (op map fn)
+ (setq fn (|genDeltaEntry| (cons op map)))
+ (if (and (consp fn) (eq (qcar fn) 'xlam))
+ (cons fn nil)
+ (cons '|call| (cons fn nil))))
+
+\end{chunk}
+
\defun{convert}{convert}
\calls{convert}{resolve}
\calls{convert}{coerce}
@@ -21535,6 +21711,77 @@ preferred to the underlying representation -- RDJ 9/12/83
\end{chunk}
+\defun{compApplication}{compApplication}
+\calls{compApplication}{eltForm}
+\calls{compApplication}{resolve}
+\calls{compApplication}{coerce}
+\calls{compApplication}{strconc}
+\calls{compApplication}{encodeItem}
+\calls{compApplication}{getAbbreviation}
+\calls{compApplication}{length}
+\calls{compApplication}{member}
+\calls{compApplication}{comp}
+\calls{compApplication}{nequal}
+\calls{compApplication}{isCategoryForm}
+\refsdollar{compApplication}{Category}
+\refsdollar{compApplication}{formatArgList}
+\refsdollar{compApplication}{op}
+\refsdollar{compApplication}{form}
+\refsdollar{compApplication}{prefix}
+\begin{chunk}{defun compApplication}
+(defun |compApplication| (op argl m env tt)
+ (let (argml retm temp1 argTl nprefix opp form eltForm)
+ (declare (special |$form| |$op| |$prefix| |$formalArgList| |$Category|))
+ (cond
+ ((and (consp (cadr tt)) (eq (qcar (cadr tt)) '|Mapping|)
+ (consp (qcdr (cadr tt))))
+ (setq retm (qcadr (cadr tt)))
+ (setq argml (qcddr (cadr tt)))
+ (cond
+ ((nequal (|#| argl) (|#| argml)) nil)
+ (t
+ (setq retm (|resolve| m retm))
+ (cond
+ ((or (equal retm |$Category|) (|isCategoryForm| retm env))
+ nil)
+ (t
+ (setq argTl
+ (loop for x in argl for m in argml
+ collect (progn
+ (setq temp1 (or (|comp| x m env) (return '|failed|)))
+ (setq env (caddr temp1))
+ temp1)))
+ (cond
+ ((eq argTl '|failed|) nil)
+ (t
+ (setq form
+ (cond
+ ((and
+ (null
+ (or (|member| op |$formalArgList|)
+ (|member| (car tt) |$formalArgList|)))
+ (atom (car tt)))
+ (setq nprefix
+ (or |$prefix| (|getAbbreviation| |$op| (|#| (cdr |$form|)))))
+ (setq opp
+ (intern
+ (strconc (|encodeItem| nprefix) '|;| (|encodeItem| (car tt)))))
+ (cons opp
+ (append
+ (loop for item in argTl collect (car item))
+ (list '$))))
+ (t
+ (cons '|call|
+ (cons (list '|applyFun| (car tt))
+ (loop for item in argTl collect (car item)))))))
+ (|coerce| (list form retm env) (|resolve| retm m)))))))))
+ ((eq op '|elt|) nil)
+ (t
+ (setq eltForm (cons '|elt| (cons op argl)))
+ (|comp| eltForm m env)))))
+
+\end{chunk}
+
\defun{getFormModemaps}{getFormModemaps}
\calls{getFormModemaps}{qcar}
\calls{getFormModemaps}{qcdr}
@@ -21787,6 +22034,90 @@ preferred to the underlying representation -- RDJ 9/12/83
\end{chunk}
+\defun{compFocompFormWithModemap}{compFocompFormWithModemap}
+\calls{compFocompFormWithModemap}{isCategoryForm}
+\calls{compFocompFormWithModemap}{isFunctor}
+\calls{compFocompFormWithModemap}{substituteIntoFunctorModemap}
+\calls{compFocompFormWithModemap}{listOfSharpVars}
+\calls{compFocompFormWithModemap}{coerceable}
+\calls{compFocompFormWithModemap}{compApplyModemap}
+\calls{compFocompFormWithModemap}{isCategoryForm}
+\calls{compFocompFormWithModemap}{identp}
+\calls{compFocompFormWithModemap}{get}
+\calls{compFocompFormWithModemap}{last}
+\calls{compFocompFormWithModemap}{convert}
+\refsdollar{compFocompFormWithModemap}{Category}
+\refsdollar{compFocompFormWithModemap}{FormalMapVariableList}
+\begin{chunk}{defun compFormWithModemap}
+(defun |compFormWithModemap| (form m env modemap)
+ (prog (op argl sv target cexpr targetp map temp1 f transimp sl mp formp z c
+ xp ep tt)
+ (declare (special |$Category| |$FormalMapVariableList|))
+ (return
+ (progn
+ (setq op (car form))
+ (setq argl (cdr form))
+ (setq map (car modemap))
+ (setq target (cadar modemap))
+ (when (and (|isCategoryForm| target env) (|isFunctor| op))
+ (setq temp1 (or (|substituteIntoFunctorModemap| argl modemap env)
+ (return nil)))
+ (setq modemap (car temp1))
+ (setq env (cadr temp1))
+ (setq map (car modemap))
+ (setq target (cadar modemap))
+ (setq cexpr (cdr modemap))
+ modemap)
+ (setq sv (|listOfSharpVars| map))
+ (when sv
+ (loop for x in argl for ss in |$FormalMapVariableList|
+ do (when (|member| ss sv)
+ (setq modemap (msubst x ss modemap))
+ (setq map (car modemap))
+ (setq target (cadar modemap))
+ (setq cexpr (cdr modemap))
+ modemap)))
+ (cond
+ ((null (setq targetp (|coerceable| target m env))) nil)
+ (t
+ (setq map (cons targetp (cdr map)))
+ (setq temp1 (or (|compApplyModemap| form modemap env nil)
+ (return nil)))
+ (setq f (car temp1))
+ (setq transimp (cadr temp1))
+ (setq sl (caddr temp1))
+ (setq mp (sublis sl (elt map 1)))
+ (setq xp
+ (progn
+ (setq formp (cons f (loop for tt in transimp collect (car tt))))
+ (cond
+ ((or (equal mp |$Category|) (|isCategoryForm| mp env)) formp)
+ ((and (eq op '|elt|) (consp f) (eq (qcar f) 'xlam)
+ (identp (car argl))
+ (setq c (|get| (car argl) '|condition| env))
+ (consp c) (eq (qcdr c) nil)
+ (consp (qcar c)) (eq (qcaar c) '|case|)
+ (consp (qcdar c)) (equal (qcadar c) z)
+ (consp (qcddar c)) (eq (qcdr (qcddar c)) nil)
+ (or (and (consp (qcaddar c))
+ (eq (qcar (qcaddar c)) '|:|)
+ (consp (qcdr (qcaddar c)))
+ (equal (qcadr (qcaddar c)) (cadr argl))
+ (consp (qcddr (qcaddar c)))
+ (eq (qcdddr (qcaddar c)) nil)
+ (equal (qcaddr (qcaddar c)) m))
+ (eq (qcaddar c) (cadr argl))))
+ (list 'cdr (car argl)))
+ (t (cons '|call| formp)))))
+ (setq ep
+ (if transimp
+ (caddr (|last| transimp))
+ env))
+ (setq tt (list xp mp ep))
+ (|convert| tt m)))))))
+
+\end{chunk}
+
\defun{compFormPartiallyBottomUp}{compFormPartiallyBottomUp}
\calls{compFormPartiallyBottomUp}{compForm3}
\calls{compFormPartiallyBottomUp}{compFormMatch}
@@ -22705,6 +23036,7 @@ The current input line.
\getchunk{defun aplTran}
\getchunk{defun aplTran1}
\getchunk{defun aplTranList}
+\getchunk{defun applyMapping}
\getchunk{defun argsToSig}
\getchunk{defun assignError}
\getchunk{defun AssocBarGensym}
@@ -22738,6 +23070,7 @@ The current input line.
\getchunk{defun comp2}
\getchunk{defun comp3}
\getchunk{defun compAdd}
+\getchunk{defun compApplication}
\getchunk{defun compApply}
\getchunk{defun compApplyModemap}
\getchunk{defun compArgumentConditions}
@@ -22784,6 +23117,7 @@ The current input line.
\getchunk{defun compFormMatch}
\getchunk{defun compForMode}
\getchunk{defun compFormPartiallyBottomUp}
+\getchunk{defun compFormWithModemap}
\getchunk{defun compFromIf}
\getchunk{defun compFunctorBody}
\getchunk{defun compHas}
@@ -22812,6 +23146,10 @@ The current input line.
\getchunk{defun compMacro}
\getchunk{defun compMakeCategoryObject}
\getchunk{defun compMakeDeclaration}
+\getchunk{defun compMapCond}
+\getchunk{defun compMapCond'}
+\getchunk{defun compMapCond''}
+\getchunk{defun compMapCondFun}
\getchunk{defun compNoStacking}
\getchunk{defun compNoStacking1}
\getchunk{defun compOrCroak}
@@ -23281,6 +23619,7 @@ The current input line.
\getchunk{defun token-lookahead-type}
\getchunk{defun token-print}
\getchunk{defun transformOperationAlist}
+\getchunk{defun transImplementation}
\getchunk{defun transIs}
\getchunk{defun transIs1}
\getchunk{defun translabel}
diff --git a/changelog b/changelog
index 6864876..e440a30 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,6 @@
+20111112 tpd src/axiom-website/patches.html 20111112.01.tpd.patch
+20111112 tpd src/interp/apply.lisp treeshake compiler
+20111112 tpd books/bookvol9 treeshake compiler
20111108 tpd src/axiom-website/patches.html 20111108.02.tpd.patch
20111108 tpd src/interp/i-spec1.lisp treeshake interpreter
20111108 tpd books/bookvol5 treeshake interpreter
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 7ba6ba9..0f90319 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -3676,5 +3676,7 @@ books/bookvolbib add references
src/axiom-website/documentation.html add Knuth quote
20111108.02.tpd.patch
books/bookvol5 treeshake interpreter
+20111112.01.tpd.patch
+books/bookvol9 treeshake compiler