diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet
index 7e0310f..edc19a4 100644
--- a/books/bookvol5.pamphlet
+++ b/books/bookvol5.pamphlet
@@ -36506,6 +36506,50 @@ constructor abbreviation to pamphlet file name.
\end{chunk}
+\defun{saveDependentsHashTable}{saveDependentsHashTable}
+\calls{saveDependentsHashTable}{erase}
+\calls{saveDependentsHashTable}{writeLib1}
+\calls{saveDependentsHashTable}{msort}
+\calls{saveDependentsHashTable}{hkeys}
+\calls{saveDependentsHashTable}{rwrite}
+\calls{saveDependentsHashTable}{hget}
+\calls{saveDependentsHashTable}{rshut}
+\refsdollar{saveDependentsHashTable}{depTb}
+\refsdollar{saveDependentsHashTable}{erase}
+\begin{chunk}{defun saveDependentsHashTable}
+(defun |saveDependentsHashTable| ()
+ (let (stream)
+ (declare (special |$depTb| $erase))
+ ($erase '|dependents| 'database '|a|)
+ (setq stream (|writeLib1| '|dependents| 'database '|a|))
+ (dolist (k (msort (hkeys |$depTb|)))
+ (|rwrite| k (hget |$depTb| k) stream))
+ (rshut stream)))
+
+\end{chunk}
+
+\defun{saveUsersHashTable}{saveUsersHashTable}
+\calls{saveUsersHashTable}{erase}
+\calls{saveUsersHashTable}{writeLib1}
+\calls{saveUsersHashTable}{msort}
+\calls{saveUsersHashTable}{hkeys}
+\calls{saveUsersHashTable}{rwrite}
+\calls{saveUsersHashTable}{hget}
+\calls{saveUsersHashTable}{rshut}
+\refsdollar{saveUsersHashTable}{erase}
+\refsdollar{saveUsersHashTable}{usersTb}
+\begin{chunk}{defun saveUsersHashTable}
+(defun |saveUsersHashTable| ()
+ (let (stream)
+ (declare (special |$usersTb| $erase))
+ ($erase '|users| 'database '|a|)
+ (setq stream (|writeLib1| '|users| 'database '|a|))
+ (dolist (k (msort (hkeys |$usersTb|)))
+ (|rwrite| k (HGET |$usersTb| k) stream))
+ (rshut stream)))
+
+\end{chunk}
+
\defun{DaaseName}{Construct the proper database full pathname}
\calls{DaaseName}{getEnv}
\usesdollar{DaaseName}{spadroot}
@@ -41032,6 +41076,8 @@ This needs to work off the internal exposure list, not the file.
\getchunk{defun saveHistory}
\getchunk{defun saveMapSig}
\getchunk{defun savesystem}
+\getchunk{defun saveDependentsHashTable}
+\getchunk{defun saveUsersHashTable}
\getchunk{defun sayAllCacheCounts}
\getchunk{defun sayBrightly1}
\getchunk{defun sayCacheCount}
diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet
index f167bcd..dd345e0 100644
--- a/books/bookvol9.pamphlet
+++ b/books/bookvol9.pamphlet
@@ -6612,6 +6612,134 @@ $\rightarrow$
\end{chunk}
+\defun{interactiveModemapForm}{interactiveModemapForm}
+Create modemap form for use by the interpreter. This function
+replaces all specific domains mentioned in the modemap with pattern
+variables, and predicates
+\calls{interactiveModemapForm}{pairp}
+\calls{interactiveModemapForm}{qcar}
+\calls{interactiveModemapForm}{qcdr}
+\calls{interactiveModemapForm}{nequal}
+\calls{interactiveModemapForm}{replaceVars}
+\calls{interactiveModemapForm}{modemapPattern}
+\calls{interactiveModemapForm}{substVars}
+\calls{interactiveModemapForm}{fixUpPredicate}
+\refsdollar{interactiveModemapForm}{PatternVariableList}
+\refsdollar{interactiveModemapForm}{FormalMapVariableList}
+\begin{chunk}{defun interactiveModemapForm}
+(defun |interactiveModemapForm| (mm)
+ (labels (
+ (fn (x)
+ (if (and (pairp x) (pairp (qcdr x))
+ (pairp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)
+ (nequal (qcar x) '|isFreeFunction|)
+ (atom (qcar (qcdr (qcdr x)))))
+ (list (first x) (second x) (list (third x)))
+ x)))
+ (let (pattern dc sig mmpat patternAlist partial patvars
+ domainPredicateList tmp1 pred dependList cond)
+ (declare (special |$PatternVariableList| |$FormalMapVariableList|))
+ (setq mm
+ (|replaceVars| (copy mm) |$PatternVariableList| |$FormalMapVariableList|))
+ (setq pattern (car mm))
+ (setq dc (caar mm))
+ (setq sig (cdar mm))
+ (setq pred (cadr mm))
+ (setq pred
+ (prog ()
+ (return
+ (do ((x pred (cdr x)) (result nil))
+ ((atom x) (nreverse0 result))
+ (setq result (cons (fn (car x)) result))))))
+ (setq tmp1 (|modemapPattern| pattern sig))
+ (setq mmpat (car tmp1))
+ (setq patternAlist (cadr tmp1))
+ (setq partial (caddr tmp1))
+ (setq patvars (cadddr tmp1))
+ (setq tmp1 (|substVars| pred patternAlist patvars))
+ (setq pred (car tmp1))
+ (setq domainPredicateList (cadr tmp1))
+ (setq tmp1 (|fixUpPredicate| pred domainPredicateList partial (cdr mmpat)))
+ (setq pred (car tmp1))
+ (setq dependList (cdr tmp1))
+ (setq cond (car pred))
+ (list mmpat cond))))
+
+\end{chunk}
+
+\defun{substVars}{substVars}
+Make pattern variable substitutions.
+\calls{substVars}{msubst}
+\calls{substVars}{nsubst}
+\calls{substVars}{contained}
+\refsdollar{substVars}{FormalMapVariableList}
+\begin{chunk}{defun substVars}
+(defun |substVars| (pred patternAlist patternVarList)
+ (let (patVar value everything replacementVar domainPredicates)
+ (declare (special |$FormalMapVariableList|))
+ (setq domainPredicates NIL)
+ (maplist
+ #'(lambda (x)
+ (setq patVar (caar x))
+ (setq value (cdar x))
+ (setq pred (msubst patVar value pred))
+ (setq patternAlist (|nsubst| patVar value patternAlist))
+ (setq domainPredicates (msubst patVar value domainPredicates))
+ (unless (member value |$FormalMapVariableList|)
+ (setq domainPredicates
+ (cons (list '|isDomain| patVar value) domainPredicates))))
+ patternAlist)
+ (setq everything (list pred patternAlist domainPredicates))
+ (dolist (|var| |$FormalMapVariableList|)
+ (cond
+ ((contained |var| everything)
+ (setq replacementVar (car patternVarList))
+ (setq patternVarList (cdr patternVarList))
+ (setq pred (msubst replacementVar |var| pred))
+ (setq domainPredicates
+ (msubst replacementVar |var| domainPredicates)))))
+ (list pred domainPredicates)))
+
+\end{chunk}
+
+\defun{modemapPattern}{modemapPattern}
+\calls{modemapPattern}{pairp}
+\calls{modemapPattern}{qcar}
+\calls{modemapPattern}{qcdr}
+\calls{modemapPattern}{rassoc}
+\refsdollar{modemapPattern}{PatternVariableList}
+\begin{chunk}{defun modemapPattern}
+(defun |modemapPattern| (mmPattern sig)
+ (let (partial patvar patvars mmpat patternAlist)
+ (declare (special |$PatternVariableList|))
+ (setq patternAlist nil)
+ (setq mmpat nil)
+ (setq patvars |$PatternVariableList|)
+ (setq partial nil)
+ (maplist
+ #'(lambda (xTails)
+ (let ((x (car xTails)))
+ (when (and (pairp x) (eq (qcar x) '|Union|)
+ (pairp (qcdr x)) (pairp (qcdr (qcdr x)))
+ (eq (qcdr (qcdr (qcdr x))) nil)
+ (equal (third x) "failed")
+ (equal xTails sig))
+ (setq x (second x))
+ (setq partial t))
+ (setq patvar (|rassoc| x patternAlist))
+ (cond
+ ((null (null patvar))
+ (setq mmpat (cons patvar mmpat)))
+ (t
+ (setq patvar (car patvars))
+ (setq patvars (cdr patvars))
+ (setq mmpat (cons patvar mmpat))
+ (setq patternAlist (cons (cons patvar x) patternAlist))))))
+ mmPattern)
+ (list (nreverse mmpat) patternAlist partial patvars)))
+
+\end{chunk}
+
\defun{evalAndRwriteLispForm}{evalAndRwriteLispForm}
\calls{evalAndRwriteLispForm}{eval}
\calls{evalAndRwriteLispForm}{rwriteLispForm}
@@ -7043,8 +7171,8 @@ where item has form
\refsdollar{transformOperationAlist}{functionLocations}
\begin{chunk}{defun transformOperationAlist}
(defun |transformOperationAlist| (operationAlist)
- (let (op sig condition implementation eltEtc tmp1 tmp2 impOp kind u n
- signatureItem itemList newAlist)
+ (let (op sig condition implementation eltEtc impOp kind u n signatureItem
+ itemList newAlist)
(declare (special |$functionLocations|))
(setq newAlist nil)
(dolist (item operationAlist)
@@ -10575,6 +10703,7 @@ An angry JHD - August 15th., 1984
\refsdollar{isDomainForm}{SpecialDomainNames}
\begin{chunk}{defun isDomainForm}
(defun |isDomainForm| (d env)
+ (let (tmp1)
(declare (special |$SpecialDomainNames|))
(or (member (kar d) |$SpecialDomainNames|) (|isFunctor| d)
(and (progn
@@ -10582,7 +10711,7 @@ An angry JHD - August 15th., 1984
(and (pairp tmp1) (eq (qcar tmp1) '|Mapping|) (pairp (qcdr tmp1))))
(|isCategoryForm| (qcar (qcdr tmp1)) env))
(|isCategoryForm| (|getmode| d env) env)
- (|isDomainConstructorForm| d env)))
+ (|isDomainConstructorForm| d env))))
\end{chunk}
@@ -18109,6 +18238,7 @@ if \verb|$InteractiveMode| then use a null outputstream
\getchunk{defun initial-substring}
\getchunk{defun initial-substring-p}
\getchunk{defun initializeLisplib}
+\getchunk{defun interactiveModemapForm}
\getchunk{defun is-console}
\getchunk{defun isDomainConstructorForm}
\getchunk{defun isDomainForm}
@@ -18153,6 +18283,7 @@ if \verb|$InteractiveMode| then use a null outputstream
\getchunk{defun mkNewModemapList}
\getchunk{defun mkOpVec}
\getchunk{defun modifyModeStack}
+\getchunk{defun modemapPattern}
\getchunk{defun ncINTERPFILE}
\getchunk{defun next-char}
@@ -18380,6 +18511,7 @@ if \verb|$InteractiveMode| then use a null outputstream
\getchunk{defun storeblanks}
\getchunk{defun substituteCategoryArguments}
\getchunk{defun substNames}
+\getchunk{defun substVars}
\getchunk{defun s-process}
\getchunk{defun token-install}
diff --git a/changelog b/changelog
index 441ff48..8132aa4 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,9 @@
+20110730 tpd src/axiom-website/patches.html 20110730.01.tpd.patch
+20110730 tpd src/interp/patches.lisp treeshake compiler
+20110730 tpd src/interp/database.lisp treeshake compiler
+20110730 tpd src/interp/br-con.lisp treeshake compiler
+20110730 tpd books/bookvol9 treeshake compiler
+20110730 tpd books/bookvol5 treeshake interpreter
20110729 tpd src/axiom-website/patches.html 20110729.01.tpd.patch
20110729 tpd src/axiom-website/download.html add ubuntu
20110728 tpd src/axiom-website/patches.html 20110728.01.tpd.patch
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 76e2f77..5ee0cb8 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -3564,5 +3564,7 @@ books/bookvol9 treeshake compiler
In process, not yet released
20110729.01.tpd.patch
src/axiom-website/download.html add ubuntu
+20110730.01.tpd.patch
+books/bookvol9 treeshake compiler