diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 2bffffd..80d0d0f 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -7028,7 +7028,7 @@ $\rightarrow$ \usesdollar{genDomainViewList}{EmptyEnvironment} \begin{chunk}{defun genDomainViewList} (defun |genDomainViewList| (id catlist firsttime) - (declare (special |$EmptyEnvironment|)) + (declare (special |$EmptyEnvironment|) (ignore firsttime)) (cond ((null catlist) nil) ((and (pairp catlist) (eq (qcdr catlist) nil) @@ -7074,6 +7074,30 @@ $\rightarrow$ \end{chunk} +\defun{augModemapsFromCategory}{augModemapsFromCategory} +\calls{augModemapsFromCategory}{evalAndSub} +\calls{augModemapsFromCategory}{compilerMessage} +\calls{augModemapsFromCategory}{putDomainsInScope} +\calls{augModemapsFromCategory}{addModemapKnown} +\defsdollar{augModemapsFromCategory}{base} +\begin{chunk}{defun augModemapsFromCategory} +(defun |augModemapsFromCategory| (domainName functorform categoryForm env) + (let (tmp1 op sig cond fnsel) + (declare (special |$base|)) + (setq tmp1 (|evalAndSub| domainName domainName functorform categoryForm env)) + (|compilerMessage| (list '|Adding | domainName '| modemaps|)) + (setq env (|putDomainsInScope| domainName (second tmp1))) + (setq |$base| 4) + (dolist (u (first tmp1)) + (setq op (caar u)) + (setq sig (cadar u)) + (setq cond (cadr u)) + (setq fnsel (caddr u)) + (setq env (|addModemapKnown| op domainName sig cond fnsel env))) + env)) + +\end{chunk} + \defun{genDomainOps}{genDomainOps} \calls{genDomainOps}{getOperationAlist} \calls{genDomainOps}{substNames} @@ -7085,7 +7109,7 @@ $\rightarrow$ \usesdollar{genDomainOps}{getDomainCode} \begin{chunk}{defun genDomainOps} (defun |genDomainOps| (viewName dom cat) - (let (siglist oplist cd opsig i) + (let (siglist oplist cd i) (declare (special |$e| |$ConditionalOperators| |$getDomainCode|)) (setq oplist (|getOperationAlist| dom dom cat)) (setq siglist (loop for lst in oplist collect (first lst))) @@ -7094,7 +7118,7 @@ $\rightarrow$ (list 'let viewName (list '|mkOpVec| dom (cons 'list - (loop for opsig in siglist do + (loop for opsig in siglist collect (list 'list (mkq (first opsig)) (cons 'list @@ -7129,7 +7153,7 @@ $\rightarrow$ \uses{mkOpVec}{Undef} \begin{chunk}{defun mkOpVec} (defun |mkOpVec| (dom siglist) - (let (substargs oplist ops u noplist n i tmp1) + (let (substargs oplist ops u noplist i tmp1) (declare (special |$FormalMapVariableList| |Undef|)) (setq dom (|getPrincipalView| dom)) (setq substargs @@ -16392,6 +16416,7 @@ if \verb|$InteractiveMode| then use a null outputstream \getchunk{defun aplTran1} \getchunk{defun aplTranList} \getchunk{defun argsToSig} +\getchunk{defun augModemapsFromCategory} \getchunk{defun blankp} \getchunk{defun bumperrorcount} diff --git a/changelog b/changelog index f989837..51606c9 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20110707 tpd src/axiom-website/patches.html 20110707.01.tpd.patch +20110707 tpd src/interp/interp-proclaims.lisp change function arity +20110707 tpd src/interp/modemap.lisp treeshake compiler +20110707 tpd books/bookvol9 treeshake compiler 20110706 tpd src/axiom-website/patches.html 20110706.01.tpd.patch 20110706 tpd src/scripts/tex/axiom.sty define \defsdollar and \refsdollar 20110706 tpd src/doc/axiom.sty define \defsdollar and \refsdollar diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index d27531f..a5aa0c8 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3528,5 +3528,7 @@ Makefile.pamphlet add BUILD=full / BUILD=fast
books/bookvol5 remove dewriteify,s inner function
20110706.01.tpd.patch books/bookvol9 use \defsdollar and \refsdollar
+20110707.01.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/interp-proclaims.lisp b/src/interp/interp-proclaims.lisp index b83fbc8..a66af84 100644 --- a/src/interp/interp-proclaims.lisp +++ b/src/interp/interp-proclaims.lisp @@ -108,6 +108,7 @@ BOOT::APP BOOT::|appagg| BOOT::|binomialApp| BOOT::|charyTrouble1| BOOT::|appsub| BOOT::|slashApp| BOOT::|appsetq| BOOT::|makeStatString| + BOOT::|augModemapsFromCategory| BOOT::|e02dffDefaultSolve| BOOT::|e04dgfDefaultSolve| BOOT::|e04fdfDefaultSolve| BOOT::|e04gcfDefaultSolve| BOOT::|f01refDefaultSolve| BOOT::|f01qefDefaultSolve|)) @@ -137,7 +138,7 @@ BOOT::|d02rafDefaultSolve|)) (PROCLAIM '(FTYPE (FUNCTION (T T T) T) BOOT::|mapRecurDepth| BOOT::THETACHECK - BOOT::|flowSegmentedMsg| BOOT::|rewriteMap0| + BOOT::|flowSegmentedMsg| BOOT::|rewriteMap0| BOOT::|genDomainView| BOOT::|restoreDependentMapInfo| BOOT::|dcSig| BOOT::|analyzeNonRecur| BOOT::|addMap| BOOT::|fortCall| BOOT::|axAddLiteral| BOOT::|writeStringLengths| @@ -456,7 +457,7 @@ BOOT::|augmentMap| BOOT::|reportFunctionCompilation| BOOT::|putSrcPos| BOOT::|hasSigInTargetCategory,fn| BOOT::|encodeFunctionName| BOOT::|getArgValueComp2| - BOOT::|augModemapsFromCategory| BOOT::|compDefineFunctor1| + BOOT::|compDefineFunctor1| BOOT::|augModemapsFromCategoryRep| BOOT::|compDefineFunctor| BOOT::|processFunctor| BOOT::|buildFunctor| BOOT::|selectMmsGen,matchMms| @@ -514,7 +515,7 @@ BOOT::|compDefWhereClause,fetchType| BOOT::|compSubDomain1| BOOT::|putFileProperty| BOOT::|srcPosNew| BOOT::|substNames| BOOT::|mac0MLambdaApply| - BOOT::|mac0ExpandBody| BOOT::|genDomainView| + BOOT::|mac0ExpandBody| BOOT::|getArgValue2| BOOT::|compFunctorBody| BOOT::|analyzeMap| BOOT::|defaultTarget| BOOT::|selectDollarMms| BOOT::|selectMmsGen| diff --git a/src/interp/modemap.lisp.pamphlet b/src/interp/modemap.lisp.pamphlet index 126835d..915fad2 100644 --- a/src/interp/modemap.lisp.pamphlet +++ b/src/interp/modemap.lisp.pamphlet @@ -785,67 +785,6 @@ (|AMFCR,redefinedList| |opname| (CDR |u|))))))))))))))) -;augModemapsFromCategory(domainName,domainView,functorForm,categoryForm,e) == -; [fnAlist,e]:= evalAndSub(domainName,domainView,functorForm,categoryForm,e) -; -- catform:= (isCategory categoryForm => categoryForm.(0); categoryForm) -; -- catform appears not to be used, so why set it? -; --if ^$InteractiveMode then -; compilerMessage ["Adding ",domainName," modemaps"] -; e:= putDomainsInScope(domainName,e) -; $base:= 4 -; condlist:=[] -; for [[op,sig,:.],cond,fnsel] in fnAlist repeat -;-- e:= addModemap(op,domainName,sig,cond,fnsel,e) -;---------next 5 lines commented out to avoid wasting time checking knownInfo on -;---------conditions attached to each modemap being added, takes a very long time -;---------instead conditions will be checked when maps are actually used -; --v:=ASSOC(cond,condlist) => -; -- e:= addModemapKnown(op,domainName,sig,CDR v,fnsel,e) -; --$e:local := e -- $e is used by knownInfo -; --if knownInfo cond then cond1:=true else cond1:=cond -; --condlist:=[[cond,:cond1],:condlist] -; e:= addModemapKnown(op,domainName,sig,cond,fnsel,e) -- cond was cond1 -;-- for u in sig | (not MEMBER(u,$DomainsInScope)) and -;-- (not atom u) and -;-- (not isCategoryForm(u,e)) do -;-- e:= addNewDomain(u,e) -; e - -(DEFUN |augModemapsFromCategory| - (|domainName| |functorForm| |categoryForm| |e|) - (PROG (|LETTMP#1| |fnAlist| |condlist| |op| |sig| |cond| |fnsel|) - (declare (special |$base|)) - (RETURN - (SEQ (PROGN - (SPADLET |LETTMP#1| - (|evalAndSub| |domainName| |domainName| - |functorForm| |categoryForm| |e|)) - (SPADLET |fnAlist| (CAR |LETTMP#1|)) - (SPADLET |e| (CADR |LETTMP#1|)) - (|compilerMessage| - (CONS '|Adding | - (CONS |domainName| (CONS '| modemaps| NIL)))) - (SPADLET |e| (|putDomainsInScope| |domainName| |e|)) - (SPADLET |$base| 4) - (SPADLET |condlist| NIL) - (DO ((G166559 |fnAlist| (CDR G166559)) - (G166548 NIL)) - ((OR (ATOM G166559) - (PROGN (SETQ G166548 (CAR G166559)) NIL) - (PROGN - (PROGN - (SPADLET |op| (CAAR G166548)) - (SPADLET |sig| (CADAR G166548)) - (SPADLET |cond| (CADR G166548)) - (SPADLET |fnsel| (CADDR G166548)) - G166548) - NIL)) - NIL) - (SEQ (EXIT (SPADLET |e| - (|addModemapKnown| |op| |domainName| - |sig| |cond| |fnsel| |e|))))) - |e|))))) - ;--subCatParametersInto(domainForm,catForm,e) == ;-- -- JHD 08/08/84 perhaps we are fortunate that it is not used ;-- --this is particularly dirty and should be cleaned up, say, by wrapping