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
diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index e9350bc..ca24050 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -1897,6 +1897,22 @@ "dependent") (|dbShowCons| |htPage| '|names|)))))) +;getDependentsOfConstructor(con) == +; stream := readLib1('dependents, 'DATABASE, 'a) +; val := rread(con, stream, nil) +; RSHUT stream +; val + +(DEFUN |getDependentsOfConstructor| (|con|) + (PROG (|stream| |val|) + (RETURN + (PROGN + (SPADLET |stream| + (|readLibPathFast| (|pathname| (list '|dependents| 'DATABASE '|a|)))) + (SPADLET |val| (|rread| |con| |stream| NIL)) + (RSHUT |stream|) + |val|)))) + ;kcuPage(htPage,junk) == ; [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts) ; conname := INTERN name @@ -1966,6 +1982,22 @@ (|htpSetProperty| |htPage| '|thing| "user") (|dbShowCons| |htPage| '|names|)))))) +;getUsersOfConstructor(con) == +; stream := readLib1('users, 'DATABASE, 'a) +; val := rread(con, stream, nil) +; RSHUT stream +; val + +(DEFUN |getUsersOfConstructor| (|con|) + (PROG (|stream| |val|) + (RETURN + (PROGN + (SPADLET |stream| + (|readLibPathFast| (|pathname| (list '|users| 'DATABASE '|a|)))) + (SPADLET |val| (|rread| |con| |stream| NIL)) + (RSHUT |stream|) + |val|)))) + ;kcnPage(htPage,junk) == ;--if reached by a category, that category has a default package ; [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(htPage,'parts) diff --git a/src/interp/database.lisp.pamphlet b/src/interp/database.lisp.pamphlet index 2e50743..c9d0bab 100644 --- a/src/interp/database.lisp.pamphlet +++ b/src/interp/database.lisp.pamphlet @@ -14,965 +14,6 @@ (SETANDFILEQ |$getUnexposedOperations| 'T) -;buildDatabase(filemode,expensive) == -; $InteractiveMode: local:= true -; $constructorList := nil --looked at by buildLibdb -; $ConstructorCache:= MAKE_-HASHTABLE('ID) -; SAY '"Making constructor autoload" -; makeConstructorsAutoLoad() -; SAY '"Building category table" -; genCategoryTable() -; SAY '"Building libdb.text" -; buildLibdb() -; SAY '"splitting libdb.text" -; dbSplitLibdb() -; SAY '"creating browse constructor index" -; dbAugmentConstructorDataTable() -; SAY '"Building browse.lisp" -; buildBrowsedb() -; SAY '"Building constructor users database" -; mkUsersHashTable() -; SAY '"Saving constructor users database" -; saveUsersHashTable() -; SAY '"Building constructor dependents database" -; mkDependentsHashTable() -; SAY '"Saving constructor dependents database" -; saveDependentsHashTable() -; SAY '"Building glossary files" -; buildGloss() - -(DEFUN |buildDatabase| (|filemode| |expensive|) - (declare (ignore |filemode| |expensive|)) - (PROG (|$InteractiveMode|) - (DECLARE (SPECIAL |$InteractiveMode| |$ConstructorCache| - |$constructorList|)) - (RETURN - (PROGN - (SPADLET |$InteractiveMode| 'T) - (SPADLET |$constructorList| NIL) - (SPADLET |$ConstructorCache| (MAKE-HASHTABLE 'ID)) - (SAY "Making constructor autoload") - (|makeConstructorsAutoLoad|) - (SAY "Building category table") - (|genCategoryTable|) - (SAY "Building libdb.text") - (|buildLibdb|) - (SAY "splitting libdb.text") - (|dbSplitLibdb|) - (SAY "creating browse constructor index") - (|dbAugmentConstructorDataTable|) - (SAY "Building browse.lisp") - (|buildBrowsedb|) - (SAY "Building constructor users database") - (|mkUsersHashTable|) - (SAY "Saving constructor users database") - (|saveUsersHashTable|) - (SAY "Building constructor dependents database") - (|mkDependentsHashTable|) - (SAY "Saving constructor dependents database") - (|saveDependentsHashTable|) - (SAY "Building glossary files") - (|buildGloss|))))) - -;saveUsersHashTable() == -; _$ERASE('users,'DATABASE,'a) -; stream:= writeLib1('users,'DATABASE,'a) -; for k in MSORT HKEYS $usersTb repeat -; rwrite(k, HGET($usersTb, k), stream) -; RSHUT stream - -(DEFUN |saveUsersHashTable| () - (PROG (|stream|) - (DECLARE (SPECIAL |$usersTb| $ERASE)) - (RETURN - (SEQ (PROGN - ($ERASE '|users| 'DATABASE '|a|) - (SPADLET |stream| (|writeLib1| '|users| 'DATABASE '|a|)) - (DO ((G166334 (MSORT (HKEYS |$usersTb|)) - (CDR G166334)) - (|k| NIL)) - ((OR (ATOM G166334) - (PROGN (SETQ |k| (CAR G166334)) NIL)) - NIL) - (SEQ (EXIT (|rwrite| |k| (HGET |$usersTb| |k|) |stream|)))) - (RSHUT |stream|)))))) - -;saveDependentsHashTable() == -; _$ERASE('dependents,'DATABASE,'a) -; stream:= writeLib1('dependents,'DATABASE,'a) -; for k in MSORT HKEYS $depTb repeat -; rwrite(k, HGET($depTb, k), stream) -; RSHUT stream - -(DEFUN |saveDependentsHashTable| () - (PROG (|stream|) - (DECLARE (SPECIAL |$depTb| $ERASE)) - (RETURN - (SEQ (PROGN - ($ERASE '|dependents| 'DATABASE '|a|) - (SPADLET |stream| - (|writeLib1| '|dependents| 'DATABASE '|a|)) - (DO ((G166348 (MSORT (HKEYS |$depTb|)) (CDR G166348)) - (|k| NIL)) - ((OR (ATOM G166348) - (PROGN (SETQ |k| (CAR G166348)) NIL)) - NIL) - (SEQ (EXIT (|rwrite| |k| (HGET |$depTb| |k|) |stream|)))) - (RSHUT |stream|)))))) - -;readLib1(fn,ft,fm) == -; -- see if it exists first -; p := pathname [fn,ft,fm] -; readLibPathFast p - -(defun |readLib1| (fn ft fm) - (|readLibPathFast| (|pathname| (list fn ft fm)))) - -;getUsersOfConstructor(con) == -; stream := readLib1('users, 'DATABASE, 'a) -; val := rread(con, stream, nil) -; RSHUT stream -; val - -(DEFUN |getUsersOfConstructor| (|con|) - (PROG (|stream| |val|) - (RETURN - (PROGN - (SPADLET |stream| (|readLib1| '|users| 'DATABASE '|a|)) - (SPADLET |val| (|rread| |con| |stream| NIL)) - (RSHUT |stream|) - |val|)))) - -;getDependentsOfConstructor(con) == -; stream := readLib1('dependents, 'DATABASE, 'a) -; val := rread(con, stream, nil) -; RSHUT stream -; val - -(DEFUN |getDependentsOfConstructor| (|con|) - (PROG (|stream| |val|) - (RETURN - (PROGN - (SPADLET |stream| (|readLib1| '|dependents| 'DATABASE '|a|)) - (SPADLET |val| (|rread| |con| |stream| NIL)) - (RSHUT |stream|) - |val|)))) - -;orderPredicateItems(pred1,sig,skip) == -; pred:= signatureTran pred1 -; pred is ["AND",:l] => orderPredTran(l,sig,skip) -; pred - -(DEFUN |orderPredicateItems| (|pred1| |sig| |skip|) - (PROG (|pred| |l|) - (RETURN - (PROGN - (SPADLET |pred| (|signatureTran| |pred1|)) - (COND - ((AND (PAIRP |pred|) (EQ (QCAR |pred|) 'AND) - (PROGN (SPADLET |l| (QCDR |pred|)) 'T)) - (|orderPredTran| |l| |sig| |skip|)) - ('T |pred|)))))) - -;orderPredTran(oldList,sig,skip) == -; lastPreds:=nil -; --(1) make two kinds of predicates appear last: -; ----- (op *target ..) when *target does not appear later in sig -; ----- (isDomain *1 ..) -; for pred in oldList repeat -; ((pred is [op,pvar,.] and MEMQ(op,'(isDomain ofCategory)) -; and pvar=first sig and ^(pvar in rest sig)) or -; (^skip and pred is ['isDomain,pvar,.] and pvar="*1")) => -; oldList:=DELETE(pred,oldList) -; lastPreds:=[pred,:lastPreds] -;--sayBrightlyNT "lastPreds=" -;--pp lastPreds -; --(2a) lastDependList=list of all variables that lastPred forms depend upon -; lastDependList := "UNIONQ"/[listOfPatternIds x for x in lastPreds] -;--sayBrightlyNT "lastDependList=" -;--pp lastDependList -; --(2b) dependList=list of all variables that isDom/ofCat forms depend upon -; dependList := -; "UNIONQ"/[listOfPatternIds y for x in oldList | -; x is ['isDomain,.,y] or x is ['ofCategory,.,y]] -;--sayBrightlyNT "dependList=" -;--pp dependList -; --(3a) newList= list of ofCat/isDom entries that don't depend on -; for x in oldList repeat -; if (x is ['ofCategory,v,body]) or (x is ['isDomain,v,body]) then -; indepvl:=listOfPatternIds v -; depvl:=listOfPatternIds body -; else -; indepvl := listOfPatternIds x -; depvl := nil -; (INTERSECTIONQ(indepvl,dependList) = nil) -; and INTERSECTIONQ(indepvl,lastDependList) => -; somethingDone := true -; lastPreds := [:lastPreds,x] -; oldList := DELETE(x,oldList) -;--if somethingDone then -;-- sayBrightlyNT "Again lastPreds=" -;-- pp lastPreds -;-- sayBrightlyNT "Again oldList=" -;-- pp oldList -; --(3b) newList= list of ofCat/isDom entries that don't depend on -; while oldList repeat -; for x in oldList repeat -; if (x is ['ofCategory,v,body]) or (x is ['isDomain,v,body]) then -; indepvl:=listOfPatternIds v -; depvl:=listOfPatternIds body -; else -; indepvl := listOfPatternIds x -; depvl := nil -; (INTERSECTIONQ(indepvl,dependList) = nil) => -; dependList:= setDifference(dependList,depvl) -; newList:= [:newList,x] -;-- sayBrightlyNT "newList=" -;-- pp newList -; --(4) noldList= what is left over -; (noldList:= setDifference(oldList,newList)) = oldList => -;-- sayMSG '"NOTE: Parameters to domain have circular dependencies" -; newList := [:newList,:oldList] -; return nil -; oldList:=noldList -;-- sayBrightlyNT "noldList=" -;-- pp noldList -; for pred in newList repeat -; if pred is ['isDomain,x,y] or x is ['ofCategory,x,y] then -; ids:= listOfPatternIds y -; if and/[id in fullDependList for id in ids] then -; fullDependList:= insertWOC(x,fullDependList) -; fullDependList:= UNIONQ(fullDependList,ids) -; newList:=[:newList,:lastPreds] -;--substitute (isDomain ..) forms as completely as possible to avoid false paths -; newList := isDomainSubst newList -; answer := [['AND,:newList],:INTERSECTIONQ(fullDependList,sig)] - -(DEFUN |orderPredTran| (|oldList| |sig| |skip|) - (PROG (|op| |pvar| |lastDependList| |somethingDone| |lastPreds| |v| - |body| |indepvl| |depvl| |dependList| |noldList| - |ISTMP#1| |x| |ISTMP#2| |y| |ids| |fullDependList| - |newList| |answer|) - (RETURN - (SEQ (PROGN - (SPADLET |lastPreds| NIL) - (SEQ (DO ((G166547 |oldList| (CDR G166547)) - (|pred| NIL)) - ((OR (ATOM G166547) - (PROGN (SETQ |pred| (CAR G166547)) NIL)) - NIL) - (SEQ (EXIT (COND - ((OR (AND (PAIRP |pred|) - (PROGN - (SPADLET |op| (QCAR |pred|)) - (SPADLET |ISTMP#1| - (QCDR |pred|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |pvar| - (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL))))) - (member |op| - '(|isDomain| |ofCategory|)) - (BOOT-EQUAL |pvar| (CAR |sig|)) - (NULL - (|member| |pvar| (CDR |sig|)))) - (AND (NULL |skip|) (PAIRP |pred|) - (EQ (QCAR |pred|) '|isDomain|) - (PROGN - (SPADLET |ISTMP#1| - (QCDR |pred|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |pvar| - (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL))))) - (BOOT-EQUAL |pvar| '*1))) - (EXIT (PROGN - (SPADLET |oldList| - (|delete| |pred| |oldList|)) - (SPADLET |lastPreds| - (CONS |pred| |lastPreds|))))))))) - (SPADLET |lastDependList| - (PROG (G166553) - (SPADLET G166553 NIL) - (RETURN - (DO ((G166558 |lastPreds| - (CDR G166558)) - (|x| NIL)) - ((OR (ATOM G166558) - (PROGN - (SETQ |x| (CAR G166558)) - NIL)) - G166553) - (SEQ (EXIT - (SETQ G166553 - (UNIONQ G166553 - (|listOfPatternIds| |x|))))))))) - (SPADLET |dependList| - (PROG (G166564) - (SPADLET G166564 NIL) - (RETURN - (DO ((G166570 |oldList| - (CDR G166570)) - (|x| NIL)) - ((OR (ATOM G166570) - (PROGN - (SETQ |x| (CAR G166570)) - NIL)) - G166564) - (SEQ (EXIT - (COND - ((OR - (AND (PAIRP |x|) - (EQ (QCAR |x|) '|isDomain|) - (PROGN - (SPADLET |ISTMP#1| - (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) - NIL) - (PROGN - (SPADLET |y| - (QCAR |ISTMP#2|)) - 'T)))))) - (AND (PAIRP |x|) - (EQ (QCAR |x|) - '|ofCategory|) - (PROGN - (SPADLET |ISTMP#1| - (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) - NIL) - (PROGN - (SPADLET |y| - (QCAR |ISTMP#2|)) - 'T))))))) - (SETQ G166564 - (UNIONQ G166564 - (|listOfPatternIds| |y|))))))))))) - (DO ((G166598 |oldList| (CDR G166598)) (|x| NIL)) - ((OR (ATOM G166598) - (PROGN (SETQ |x| (CAR G166598)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (COND - ((OR - (AND (PAIRP |x|) - (EQ (QCAR |x|) '|ofCategory|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |v| - (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |body| - (QCAR |ISTMP#2|)) - 'T)))))) - (AND (PAIRP |x|) - (EQ (QCAR |x|) '|isDomain|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |v| - (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |body| - (QCAR |ISTMP#2|)) - 'T))))))) - (SPADLET |indepvl| - (|listOfPatternIds| |v|)) - (SPADLET |depvl| - (|listOfPatternIds| |body|))) - ('T - (SPADLET |indepvl| - (|listOfPatternIds| |x|)) - (SPADLET |depvl| NIL))) - (COND - ((AND - (NULL - (INTERSECTIONQ |indepvl| - |dependList|)) - (INTERSECTIONQ |indepvl| - |lastDependList|)) - (PROGN - (SPADLET |somethingDone| 'T) - (SPADLET |lastPreds| - (APPEND |lastPreds| - (CONS |x| NIL))) - (SPADLET |oldList| - (|delete| |x| |oldList|))))))))) - (DO () ((NULL |oldList|) NIL) - (SEQ (EXIT (PROGN - (DO ((G166651 |oldList| - (CDR G166651)) - (|x| NIL)) - ((OR (ATOM G166651) - (PROGN - (SETQ |x| (CAR G166651)) - NIL)) - NIL) - (SEQ - (EXIT - (PROGN - (COND - ((OR - (AND (PAIRP |x|) - (EQ (QCAR |x|) - '|ofCategory|) - (PROGN - (SPADLET |ISTMP#1| - (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |v| - (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) - NIL) - (PROGN - (SPADLET |body| - (QCAR |ISTMP#2|)) - 'T)))))) - (AND (PAIRP |x|) - (EQ (QCAR |x|) '|isDomain|) - (PROGN - (SPADLET |ISTMP#1| - (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |v| - (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) - NIL) - (PROGN - (SPADLET |body| - (QCAR |ISTMP#2|)) - 'T))))))) - (SPADLET |indepvl| - (|listOfPatternIds| |v|)) - (SPADLET |depvl| - (|listOfPatternIds| |body|))) - ('T - (SPADLET |indepvl| - (|listOfPatternIds| |x|)) - (SPADLET |depvl| NIL))) - (COND - ((NULL - (INTERSECTIONQ |indepvl| - |dependList|)) - (PROGN - (SPADLET |dependList| - (SETDIFFERENCE - |dependList| |depvl|)) - (SPADLET |newList| - (APPEND |newList| - (CONS |x| NIL)))))))))) - (COND - ((BOOT-EQUAL - (SPADLET |noldList| - (SETDIFFERENCE |oldList| - |newList|)) - |oldList|) - (SPADLET |newList| - (APPEND |newList| |oldList|)) - (RETURN NIL)) - ('T (SPADLET |oldList| |noldList|))))))) - (DO ((G166674 |newList| (CDR G166674)) - (|pred| NIL)) - ((OR (ATOM G166674) - (PROGN (SETQ |pred| (CAR G166674)) NIL)) - NIL) - (SEQ (EXIT (COND - ((OR (AND (PAIRP |pred|) - (EQ (QCAR |pred|) '|isDomain|) - (PROGN - (SPADLET |ISTMP#1| - (QCDR |pred|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |x| - (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |y| - (QCAR |ISTMP#2|)) - 'T)))))) - (AND (PAIRP |x|) - (EQ (QCAR |x|) '|ofCategory|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |x| - (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |y| - (QCAR |ISTMP#2|)) - 'T))))))) - (SPADLET |ids| - (|listOfPatternIds| |y|)) - (COND - ((PROG (G166680) - (SPADLET G166680 'T) - (RETURN - (DO - ((G166686 NIL - (NULL G166680)) - (G166687 |ids| - (CDR G166687)) - (|id| NIL)) - ((OR G166686 - (ATOM G166687) - (PROGN - (SETQ |id| - (CAR G166687)) - NIL)) - G166680) - (SEQ - (EXIT - (SETQ G166680 - (AND G166680 - (|member| |id| - |fullDependList|)))))))) - (SPADLET |fullDependList| - (|insertWOC| |x| - |fullDependList|)))) - (SPADLET |fullDependList| - (UNIONQ |fullDependList| - |ids|))) - ('T NIL))))) - (SPADLET |newList| (APPEND |newList| |lastPreds|)) - (SPADLET |newList| (|isDomainSubst| |newList|)) - (SPADLET |answer| - (CONS (CONS 'AND |newList|) - (INTERSECTIONQ |fullDependList| |sig|))))))))) - -;--sayBrightlyNT '"answer=" -;--pp answer -;isDomainSubst u == main where -; main == -; u is [head,:tail] => -; nhead := -; head is ['isDomain,x,y] => ['isDomain,x,fn(y,tail)] -; head -; [nhead,:isDomainSubst rest u] -; u -; fn(x,alist) == -; atom x => -; IDENTP x and MEMQ(x,$PatternVariableList) and (s := findSub(x,alist)) => s -; x -; [CAR x,:[fn(y,alist) for y in CDR x]] -; findSub(x,alist) == -; null alist => nil -; alist is [['isDomain,y,z],:.] and x = y => z -; findSub(x,rest alist) - -(DEFUN |isDomainSubst,findSub| (|x| |alist|) - (PROG (|ISTMP#1| |ISTMP#2| |y| |ISTMP#3| |z|) - (RETURN - (SEQ (IF (NULL |alist|) (EXIT NIL)) - (IF (AND (AND (PAIRP |alist|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |alist|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) '|isDomain|) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |y| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| - (QCDR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN - (SPADLET |z| - (QCAR |ISTMP#3|)) - 'T)))))))) - (BOOT-EQUAL |x| |y|)) - (EXIT |z|)) - (EXIT (|isDomainSubst,findSub| |x| (CDR |alist|))))))) - -(DEFUN |isDomainSubst,fn| (|x| |alist|) - (PROG (|s|) - (DECLARE (SPECIAL |$PatternVariableList|)) - (RETURN - (SEQ (IF (ATOM |x|) - (EXIT (SEQ (IF (AND (AND (IDENTP |x|) - (member |x| |$PatternVariableList|)) - (SPADLET |s| - (|isDomainSubst,findSub| |x| - |alist|))) - (EXIT |s|)) - (EXIT |x|)))) - (EXIT (CONS (CAR |x|) - (PROG (G166826) - (SPADLET G166826 NIL) - (RETURN - (DO ((G166831 (CDR |x|) (CDR G166831)) - (|y| NIL)) - ((OR (ATOM G166831) - (PROGN - (SETQ |y| (CAR G166831)) - NIL)) - (NREVERSE0 G166826)) - (SEQ (EXIT (SETQ G166826 - (CONS - (|isDomainSubst,fn| |y| - |alist|) - G166826))))))))))))) - -(DEFUN |isDomainSubst| (|u|) - (PROG (|head| |tail| |ISTMP#1| |x| |ISTMP#2| |y| |nhead|) - (RETURN - (COND - ((AND (PAIRP |u|) - (PROGN - (SPADLET |head| (QCAR |u|)) - (SPADLET |tail| (QCDR |u|)) - 'T)) - (SPADLET |nhead| - (COND - ((AND (PAIRP |head|) (EQ (QCAR |head|) '|isDomain|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |head|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |x| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |y| (QCAR |ISTMP#2|)) - 'T)))))) - (CONS '|isDomain| - (CONS |x| - (CONS (|isDomainSubst,fn| |y| |tail|) - NIL)))) - ('T |head|))) - (CONS |nhead| (|isDomainSubst| (CDR |u|)))) - ('T |u|))))) - -;signatureTran pred == -; atom pred => pred -; pred is ['has,D,catForm] and isCategoryForm(catForm,$e) => -; ['ofCategory,D,catForm] -; [signatureTran p for p in pred] - -(DEFUN |signatureTran| (|pred|) - (PROG (|ISTMP#1| D |ISTMP#2| |catForm|) - (DECLARE (SPECIAL |$e|)) - (RETURN - (SEQ (COND - ((ATOM |pred|) |pred|) - ((AND (PAIRP |pred|) (EQ (QCAR |pred|) '|has|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |pred|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET D (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |catForm| (QCAR |ISTMP#2|)) - 'T))))) - (|isCategoryForm| |catForm| |$e|)) - (CONS '|ofCategory| (CONS D (CONS |catForm| NIL)))) - ('T - (PROG (G166884) - (SPADLET G166884 NIL) - (RETURN - (DO ((G166889 |pred| (CDR G166889)) (|p| NIL)) - ((OR (ATOM G166889) - (PROGN (SETQ |p| (CAR G166889)) NIL)) - (NREVERSE0 G166884)) - (SEQ (EXIT (SETQ G166884 - (CONS (|signatureTran| |p|) - G166884))))))))))))) - -;interactiveModemapForm mm == -; -- create modemap form for use by the interpreter. This function -; -- replaces all specific domains mentioned in the modemap with pattern -; -- variables, and predicates -; mm := replaceVars(COPY mm,$PatternVariableList,$FormalMapVariableList) -; [pattern:=[dc,:sig],pred] := mm -; pred := [fn x for x in pred] where fn x == -; x is [a,b,c] and a ^= 'isFreeFunction and atom c => [a,b,[c]] -; x -;--pp pred -; [mmpat, patternAlist, partial, patvars] := -; modemapPattern(pattern,sig) -;--pp [pattern, mmpat, patternAlist, partial, patvars] -; [pred,domainPredicateList] := -; substVars(pred,patternAlist,patvars) -;--pp [pred,domainPredicateList] -; [pred,:dependList]:= -; fixUpPredicate(pred,domainPredicateList,partial,rest mmpat) -;--pp [pred,dependList] -; [cond, :.] := pred -; [mmpat, cond] - -(DEFUN |interactiveModemapForm,fn| (|x|) - (PROG (|a| |ISTMP#1| |b| |ISTMP#2| |c|) - (RETURN - (SEQ (IF (AND (AND (AND (PAIRP |x|) - (PROGN - (SPADLET |a| (QCAR |x|)) - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |b| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |c| - (QCAR |ISTMP#2|)) - 'T)))))) - (NEQUAL |a| '|isFreeFunction|)) - (ATOM |c|)) - (EXIT (CONS |a| (CONS |b| (CONS (CONS |c| NIL) NIL))))) - (EXIT |x|))))) - -(DEFUN |interactiveModemapForm| (|mm|) - (PROG (|pattern| |dc| |sig| |mmpat| |patternAlist| |partial| - |patvars| |domainPredicateList| |LETTMP#1| |pred| - |dependList| |cond|) - (DECLARE (SPECIAL |$PatternVariableList| |$FormalMapVariableList|)) - (RETURN - (SEQ (PROGN - (SPADLET |mm| - (|replaceVars| (COPY |mm|) |$PatternVariableList| - |$FormalMapVariableList|)) - (SPADLET |pattern| (CAR |mm|)) - (SPADLET |dc| (CAAR |mm|)) - (SPADLET |sig| (CDAR |mm|)) - (SPADLET |pred| (CADR |mm|)) - (SPADLET |pred| - (PROG (G166974) - (SPADLET G166974 NIL) - (RETURN - (DO ((G166979 |pred| (CDR G166979)) - (|x| NIL)) - ((OR (ATOM G166979) - (PROGN - (SETQ |x| (CAR G166979)) - NIL)) - (NREVERSE0 G166974)) - (SEQ (EXIT (SETQ G166974 - (CONS - (|interactiveModemapForm,fn| - |x|) - G166974)))))))) - (SPADLET |LETTMP#1| (|modemapPattern| |pattern| |sig|)) - (SPADLET |mmpat| (CAR |LETTMP#1|)) - (SPADLET |patternAlist| (CADR |LETTMP#1|)) - (SPADLET |partial| (CADDR |LETTMP#1|)) - (SPADLET |patvars| (CADDDR |LETTMP#1|)) - (SPADLET |LETTMP#1| - (|substVars| |pred| |patternAlist| |patvars|)) - (SPADLET |pred| (CAR |LETTMP#1|)) - (SPADLET |domainPredicateList| (CADR |LETTMP#1|)) - (SPADLET |LETTMP#1| - (|fixUpPredicate| |pred| |domainPredicateList| - |partial| (CDR |mmpat|))) - (SPADLET |pred| (CAR |LETTMP#1|)) - (SPADLET |dependList| (CDR |LETTMP#1|)) - (SPADLET |cond| (CAR |pred|)) - (CONS |mmpat| (CONS |cond| NIL))))))) - -;modemapPattern(mmPattern,sig) == -; -- Returns a list of the pattern of a modemap, an Alist of the -; -- substitutions made, a boolean flag indicating whether -; -- the result type is partial, and a list of unused pattern variables -; patternAlist := nil -; mmpat := nil -; patvars := $PatternVariableList -; partial := false -; for xTails in tails mmPattern repeat -; x := first xTails -; if x is ['Union,dom,tag] and tag = '"failed" and xTails=sig then -; x := dom -; partial := true -; patvar := RASSOC(x,patternAlist) -; not null patvar => mmpat := [patvar,:mmpat] -; patvar := first patvars -; patvars := rest patvars -; mmpat := [patvar,:mmpat] -; patternAlist := [[patvar,:x],:patternAlist] -; [NREVERSE mmpat,patternAlist,partial,patvars] - -(DEFUN |modemapPattern| (|mmPattern| |sig|) - (PROG (|ISTMP#1| |dom| |ISTMP#2| |tag| |x| |partial| |patvar| - |patvars| |mmpat| |patternAlist|) - (DECLARE (SPECIAL |$PatternVariableList|)) - (RETURN - (SEQ (PROGN - (SPADLET |patternAlist| NIL) - (SPADLET |mmpat| NIL) - (SPADLET |patvars| |$PatternVariableList|) - (SPADLET |partial| NIL) - (DO ((|xTails| |mmPattern| (CDR |xTails|))) - ((ATOM |xTails|) NIL) - (SEQ (EXIT (PROGN - (SPADLET |x| (CAR |xTails|)) - (COND - ((AND (PAIRP |x|) - (EQ (QCAR |x|) '|Union|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |dom| - (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |tag| - (QCAR |ISTMP#2|)) - 'T))))) - (BOOT-EQUAL |tag| - "failed") - (BOOT-EQUAL |xTails| |sig|)) - (SPADLET |x| |dom|) - (SPADLET |partial| 'T))) - (SPADLET |patvar| - (|rassoc| |x| |patternAlist|)) - (COND - ((NULL (NULL |patvar|)) - (SPADLET |mmpat| - (CONS |patvar| |mmpat|))) - ('T (SPADLET |patvar| (CAR |patvars|)) - (SPADLET |patvars| (CDR |patvars|)) - (SPADLET |mmpat| - (CONS |patvar| |mmpat|)) - (SPADLET |patternAlist| - (CONS (CONS |patvar| |x|) - |patternAlist|)))))))) - (CONS (NREVERSE |mmpat|) - (CONS |patternAlist| - (CONS |partial| (CONS |patvars| NIL))))))))) - -;substVars(pred,patternAlist,patternVarList) == -; --make pattern variable substitutions -; domainPredicates := nil -; for [[patVar,:value],:.] in tails patternAlist repeat -; pred := substitute(patVar,value,pred) -; patternAlist := nsubst(patVar,value,patternAlist) -; domainPredicates := substitute(patVar,value,domainPredicates) -; if ^MEMQ(value,$FormalMapVariableList) then -; domainPredicates := [["isDomain",patVar,value],:domainPredicates] -; everything := [pred,patternAlist,domainPredicates] -; for var in $FormalMapVariableList repeat -; CONTAINED(var,everything) => -; replacementVar := first patternVarList -; patternVarList := rest patternVarList -; pred := substitute(replacementVar,var,pred) -; domainPredicates := substitute(replacementVar,var,domainPredicates) -; [pred, domainPredicates] - -(DEFUN |substVars| (|pred| |patternAlist| |patternVarList|) - (PROG (|patVar| |value| |everything| |replacementVar| - |domainPredicates|) - (DECLARE (SPECIAL |$FormalMapVariableList|)) - (RETURN - (SEQ (PROGN - (SPADLET |domainPredicates| NIL) - (DO ((G167064 |patternAlist| (CDR G167064))) - ((OR (ATOM G167064) - (PROGN - (PROGN - (SPADLET |patVar| (CAAR G167064)) - (SPADLET |value| (CDAR G167064)) - G167064) - NIL)) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |pred| - (MSUBST |patVar| |value| |pred|)) - (SPADLET |patternAlist| - (|nsubst| |patVar| |value| - |patternAlist|)) - (SPADLET |domainPredicates| - (MSUBST |patVar| |value| - |domainPredicates|)) - (COND - ((NULL (member |value| - |$FormalMapVariableList|)) - (SPADLET |domainPredicates| - (CONS - (CONS '|isDomain| - (CONS |patVar| - (CONS |value| NIL))) - |domainPredicates|))) - ('T NIL)))))) - (SPADLET |everything| - (CONS |pred| - (CONS |patternAlist| - (CONS |domainPredicates| NIL)))) - (SEQ (DO ((G167089 |$FormalMapVariableList| - (CDR G167089)) - (|var| NIL)) - ((OR (ATOM G167089) - (PROGN (SETQ |var| (CAR G167089)) NIL)) - NIL) - (SEQ (EXIT (COND - ((CONTAINED |var| |everything|) - (EXIT (PROGN - (SPADLET |replacementVar| - (CAR |patternVarList|)) - (SPADLET |patternVarList| - (CDR |patternVarList|)) - (SPADLET |pred| - (MSUBST |replacementVar| - |var| |pred|)) - (SPADLET |domainPredicates| - (MSUBST |replacementVar| - |var| |domainPredicates|))))))))) - (CONS |pred| (CONS |domainPredicates| NIL)))))))) - ;fixUpPredicate(predClause, domainPreds, partial, sig) == ; -- merge the predicates in predClause and domainPreds into a ; -- single predicate @@ -1911,8 +952,7 @@ ((member '|dependents| (RKEYIDS |fn| |$spadLibFT|)) (EXIT (PROGN (SPADLET |stream| - (|readLib1| |fn| |$spadLibFT| - '*)) + (|readLibPathFast| (|pathname| (list |fn| |$spadLibFT| '*)))) (SPADLET |l| (|rread| '|dependents| |stream| NIL)) @@ -2102,6 +1142,578 @@ |found|)))))) +;orderPredicateItems(pred1,sig,skip) == +; pred:= signatureTran pred1 +; pred is ["AND",:l] => orderPredTran(l,sig,skip) +; pred + +(DEFUN |orderPredicateItems| (|pred1| |sig| |skip|) + (PROG (|pred| |l|) + (RETURN + (PROGN + (SPADLET |pred| (|signatureTran| |pred1|)) + (COND + ((AND (PAIRP |pred|) (EQ (QCAR |pred|) 'AND) + (PROGN (SPADLET |l| (QCDR |pred|)) 'T)) + (|orderPredTran| |l| |sig| |skip|)) + ('T |pred|)))))) + +;orderPredTran(oldList,sig,skip) == +; lastPreds:=nil +; --(1) make two kinds of predicates appear last: +; ----- (op *target ..) when *target does not appear later in sig +; ----- (isDomain *1 ..) +; for pred in oldList repeat +; ((pred is [op,pvar,.] and MEMQ(op,'(isDomain ofCategory)) +; and pvar=first sig and ^(pvar in rest sig)) or +; (^skip and pred is ['isDomain,pvar,.] and pvar="*1")) => +; oldList:=DELETE(pred,oldList) +; lastPreds:=[pred,:lastPreds] +;--sayBrightlyNT "lastPreds=" +;--pp lastPreds +; --(2a) lastDependList=list of all variables that lastPred forms depend upon +; lastDependList := "UNIONQ"/[listOfPatternIds x for x in lastPreds] +;--sayBrightlyNT "lastDependList=" +;--pp lastDependList +; --(2b) dependList=list of all variables that isDom/ofCat forms depend upon +; dependList := +; "UNIONQ"/[listOfPatternIds y for x in oldList | +; x is ['isDomain,.,y] or x is ['ofCategory,.,y]] +;--sayBrightlyNT "dependList=" +;--pp dependList +; --(3a) newList= list of ofCat/isDom entries that don't depend on +; for x in oldList repeat +; if (x is ['ofCategory,v,body]) or (x is ['isDomain,v,body]) then +; indepvl:=listOfPatternIds v +; depvl:=listOfPatternIds body +; else +; indepvl := listOfPatternIds x +; depvl := nil +; (INTERSECTIONQ(indepvl,dependList) = nil) +; and INTERSECTIONQ(indepvl,lastDependList) => +; somethingDone := true +; lastPreds := [:lastPreds,x] +; oldList := DELETE(x,oldList) +;--if somethingDone then +;-- sayBrightlyNT "Again lastPreds=" +;-- pp lastPreds +;-- sayBrightlyNT "Again oldList=" +;-- pp oldList +; --(3b) newList= list of ofCat/isDom entries that don't depend on +; while oldList repeat +; for x in oldList repeat +; if (x is ['ofCategory,v,body]) or (x is ['isDomain,v,body]) then +; indepvl:=listOfPatternIds v +; depvl:=listOfPatternIds body +; else +; indepvl := listOfPatternIds x +; depvl := nil +; (INTERSECTIONQ(indepvl,dependList) = nil) => +; dependList:= setDifference(dependList,depvl) +; newList:= [:newList,x] +;-- sayBrightlyNT "newList=" +;-- pp newList +; --(4) noldList= what is left over +; (noldList:= setDifference(oldList,newList)) = oldList => +;-- sayMSG '"NOTE: Parameters to domain have circular dependencies" +; newList := [:newList,:oldList] +; return nil +; oldList:=noldList +;-- sayBrightlyNT "noldList=" +;-- pp noldList +; for pred in newList repeat +; if pred is ['isDomain,x,y] or x is ['ofCategory,x,y] then +; ids:= listOfPatternIds y +; if and/[id in fullDependList for id in ids] then +; fullDependList:= insertWOC(x,fullDependList) +; fullDependList:= UNIONQ(fullDependList,ids) +; newList:=[:newList,:lastPreds] +;--substitute (isDomain ..) forms as completely as possible to avoid false paths +; newList := isDomainSubst newList +; answer := [['AND,:newList],:INTERSECTIONQ(fullDependList,sig)] + +(DEFUN |orderPredTran| (|oldList| |sig| |skip|) + (PROG (|op| |pvar| |lastDependList| |somethingDone| |lastPreds| |v| + |body| |indepvl| |depvl| |dependList| |noldList| + |ISTMP#1| |x| |ISTMP#2| |y| |ids| |fullDependList| + |newList| |answer|) + (RETURN + (SEQ (PROGN + (SPADLET |lastPreds| NIL) + (SEQ (DO ((G166547 |oldList| (CDR G166547)) + (|pred| NIL)) + ((OR (ATOM G166547) + (PROGN (SETQ |pred| (CAR G166547)) NIL)) + NIL) + (SEQ (EXIT (COND + ((OR (AND (PAIRP |pred|) + (PROGN + (SPADLET |op| (QCAR |pred|)) + (SPADLET |ISTMP#1| + (QCDR |pred|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |pvar| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL))))) + (member |op| + '(|isDomain| |ofCategory|)) + (BOOT-EQUAL |pvar| (CAR |sig|)) + (NULL + (|member| |pvar| (CDR |sig|)))) + (AND (NULL |skip|) (PAIRP |pred|) + (EQ (QCAR |pred|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |pred|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |pvar| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL))))) + (BOOT-EQUAL |pvar| '*1))) + (EXIT (PROGN + (SPADLET |oldList| + (|delete| |pred| |oldList|)) + (SPADLET |lastPreds| + (CONS |pred| |lastPreds|))))))))) + (SPADLET |lastDependList| + (PROG (G166553) + (SPADLET G166553 NIL) + (RETURN + (DO ((G166558 |lastPreds| + (CDR G166558)) + (|x| NIL)) + ((OR (ATOM G166558) + (PROGN + (SETQ |x| (CAR G166558)) + NIL)) + G166553) + (SEQ (EXIT + (SETQ G166553 + (UNIONQ G166553 + (|listOfPatternIds| |x|))))))))) + (SPADLET |dependList| + (PROG (G166564) + (SPADLET G166564 NIL) + (RETURN + (DO ((G166570 |oldList| + (CDR G166570)) + (|x| NIL)) + ((OR (ATOM G166570) + (PROGN + (SETQ |x| (CAR G166570)) + NIL)) + G166564) + (SEQ (EXIT + (COND + ((OR + (AND (PAIRP |x|) + (EQ (QCAR |x|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) + NIL) + (PROGN + (SPADLET |y| + (QCAR |ISTMP#2|)) + 'T)))))) + (AND (PAIRP |x|) + (EQ (QCAR |x|) + '|ofCategory|) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) + NIL) + (PROGN + (SPADLET |y| + (QCAR |ISTMP#2|)) + 'T))))))) + (SETQ G166564 + (UNIONQ G166564 + (|listOfPatternIds| |y|))))))))))) + (DO ((G166598 |oldList| (CDR G166598)) (|x| NIL)) + ((OR (ATOM G166598) + (PROGN (SETQ |x| (CAR G166598)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (COND + ((OR + (AND (PAIRP |x|) + (EQ (QCAR |x|) '|ofCategory|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |v| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |body| + (QCAR |ISTMP#2|)) + 'T)))))) + (AND (PAIRP |x|) + (EQ (QCAR |x|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |v| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |body| + (QCAR |ISTMP#2|)) + 'T))))))) + (SPADLET |indepvl| + (|listOfPatternIds| |v|)) + (SPADLET |depvl| + (|listOfPatternIds| |body|))) + ('T + (SPADLET |indepvl| + (|listOfPatternIds| |x|)) + (SPADLET |depvl| NIL))) + (COND + ((AND + (NULL + (INTERSECTIONQ |indepvl| + |dependList|)) + (INTERSECTIONQ |indepvl| + |lastDependList|)) + (PROGN + (SPADLET |somethingDone| 'T) + (SPADLET |lastPreds| + (APPEND |lastPreds| + (CONS |x| NIL))) + (SPADLET |oldList| + (|delete| |x| |oldList|))))))))) + (DO () ((NULL |oldList|) NIL) + (SEQ (EXIT (PROGN + (DO ((G166651 |oldList| + (CDR G166651)) + (|x| NIL)) + ((OR (ATOM G166651) + (PROGN + (SETQ |x| (CAR G166651)) + NIL)) + NIL) + (SEQ + (EXIT + (PROGN + (COND + ((OR + (AND (PAIRP |x|) + (EQ (QCAR |x|) + '|ofCategory|) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |v| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) + NIL) + (PROGN + (SPADLET |body| + (QCAR |ISTMP#2|)) + 'T)))))) + (AND (PAIRP |x|) + (EQ (QCAR |x|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |v| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) + NIL) + (PROGN + (SPADLET |body| + (QCAR |ISTMP#2|)) + 'T))))))) + (SPADLET |indepvl| + (|listOfPatternIds| |v|)) + (SPADLET |depvl| + (|listOfPatternIds| |body|))) + ('T + (SPADLET |indepvl| + (|listOfPatternIds| |x|)) + (SPADLET |depvl| NIL))) + (COND + ((NULL + (INTERSECTIONQ |indepvl| + |dependList|)) + (PROGN + (SPADLET |dependList| + (SETDIFFERENCE + |dependList| |depvl|)) + (SPADLET |newList| + (APPEND |newList| + (CONS |x| NIL)))))))))) + (COND + ((BOOT-EQUAL + (SPADLET |noldList| + (SETDIFFERENCE |oldList| + |newList|)) + |oldList|) + (SPADLET |newList| + (APPEND |newList| |oldList|)) + (RETURN NIL)) + ('T (SPADLET |oldList| |noldList|))))))) + (DO ((G166674 |newList| (CDR G166674)) + (|pred| NIL)) + ((OR (ATOM G166674) + (PROGN (SETQ |pred| (CAR G166674)) NIL)) + NIL) + (SEQ (EXIT (COND + ((OR (AND (PAIRP |pred|) + (EQ (QCAR |pred|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |pred|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |x| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |y| + (QCAR |ISTMP#2|)) + 'T)))))) + (AND (PAIRP |x|) + (EQ (QCAR |x|) '|ofCategory|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |x| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |y| + (QCAR |ISTMP#2|)) + 'T))))))) + (SPADLET |ids| + (|listOfPatternIds| |y|)) + (COND + ((PROG (G166680) + (SPADLET G166680 'T) + (RETURN + (DO + ((G166686 NIL + (NULL G166680)) + (G166687 |ids| + (CDR G166687)) + (|id| NIL)) + ((OR G166686 + (ATOM G166687) + (PROGN + (SETQ |id| + (CAR G166687)) + NIL)) + G166680) + (SEQ + (EXIT + (SETQ G166680 + (AND G166680 + (|member| |id| + |fullDependList|)))))))) + (SPADLET |fullDependList| + (|insertWOC| |x| + |fullDependList|)))) + (SPADLET |fullDependList| + (UNIONQ |fullDependList| + |ids|))) + ('T NIL))))) + (SPADLET |newList| (APPEND |newList| |lastPreds|)) + (SPADLET |newList| (|isDomainSubst| |newList|)) + (SPADLET |answer| + (CONS (CONS 'AND |newList|) + (INTERSECTIONQ |fullDependList| |sig|))))))))) + + +;--sayBrightlyNT '"answer=" +;--pp answer +;isDomainSubst u == main where +; main == +; u is [head,:tail] => +; nhead := +; head is ['isDomain,x,y] => ['isDomain,x,fn(y,tail)] +; head +; [nhead,:isDomainSubst rest u] +; u +; fn(x,alist) == +; atom x => +; IDENTP x and MEMQ(x,$PatternVariableList) and (s := findSub(x,alist)) => s +; x +; [CAR x,:[fn(y,alist) for y in CDR x]] +; findSub(x,alist) == +; null alist => nil +; alist is [['isDomain,y,z],:.] and x = y => z +; findSub(x,rest alist) + +(DEFUN |isDomainSubst,findSub| (|x| |alist|) + (PROG (|ISTMP#1| |ISTMP#2| |y| |ISTMP#3| |z|) + (RETURN + (SEQ (IF (NULL |alist|) (EXIT NIL)) + (IF (AND (AND (PAIRP |alist|) + (PROGN + (SPADLET |ISTMP#1| (QCAR |alist|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |y| (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| + (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN + (SPADLET |z| + (QCAR |ISTMP#3|)) + 'T)))))))) + (BOOT-EQUAL |x| |y|)) + (EXIT |z|)) + (EXIT (|isDomainSubst,findSub| |x| (CDR |alist|))))))) + +(DEFUN |isDomainSubst,fn| (|x| |alist|) + (PROG (|s|) + (DECLARE (SPECIAL |$PatternVariableList|)) + (RETURN + (SEQ (IF (ATOM |x|) + (EXIT (SEQ (IF (AND (AND (IDENTP |x|) + (member |x| |$PatternVariableList|)) + (SPADLET |s| + (|isDomainSubst,findSub| |x| + |alist|))) + (EXIT |s|)) + (EXIT |x|)))) + (EXIT (CONS (CAR |x|) + (PROG (G166826) + (SPADLET G166826 NIL) + (RETURN + (DO ((G166831 (CDR |x|) (CDR G166831)) + (|y| NIL)) + ((OR (ATOM G166831) + (PROGN + (SETQ |y| (CAR G166831)) + NIL)) + (NREVERSE0 G166826)) + (SEQ (EXIT (SETQ G166826 + (CONS + (|isDomainSubst,fn| |y| + |alist|) + G166826))))))))))))) + +(DEFUN |isDomainSubst| (|u|) + (PROG (|head| |tail| |ISTMP#1| |x| |ISTMP#2| |y| |nhead|) + (RETURN + (COND + ((AND (PAIRP |u|) + (PROGN + (SPADLET |head| (QCAR |u|)) + (SPADLET |tail| (QCDR |u|)) + 'T)) + (SPADLET |nhead| + (COND + ((AND (PAIRP |head|) (EQ (QCAR |head|) '|isDomain|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |head|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |x| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |y| (QCAR |ISTMP#2|)) + 'T)))))) + (CONS '|isDomain| + (CONS |x| + (CONS (|isDomainSubst,fn| |y| |tail|) + NIL)))) + ('T |head|))) + (CONS |nhead| (|isDomainSubst| (CDR |u|)))) + ('T |u|))))) + +;signatureTran pred == +; atom pred => pred +; pred is ['has,D,catForm] and isCategoryForm(catForm,$e) => +; ['ofCategory,D,catForm] +; [signatureTran p for p in pred] + +(DEFUN |signatureTran| (|pred|) + (PROG (|ISTMP#1| D |ISTMP#2| |catForm|) + (DECLARE (SPECIAL |$e|)) + (RETURN + (SEQ (COND + ((ATOM |pred|) |pred|) + ((AND (PAIRP |pred|) (EQ (QCAR |pred|) '|has|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |pred|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET D (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |catForm| (QCAR |ISTMP#2|)) + 'T))))) + (|isCategoryForm| |catForm| |$e|)) + (CONS '|ofCategory| (CONS D (CONS |catForm| NIL)))) + ('T + (PROG (G166884) + (SPADLET G166884 NIL) + (RETURN + (DO ((G166889 |pred| (CDR G166889)) (|p| NIL)) + ((OR (ATOM G166889) + (PROGN (SETQ |p| (CAR G166889)) NIL)) + (NREVERSE0 G166884)) + (SEQ (EXIT (SETQ G166884 + (CONS (|signatureTran| |p|) + G166884))))))))))))) + \end{chunk} \eject \begin{thebibliography}{99} diff --git a/src/interp/patches.lisp.pamphlet b/src/interp/patches.lisp.pamphlet index 0ea6786..c85f18a 100644 --- a/src/interp/patches.lisp.pamphlet +++ b/src/interp/patches.lisp.pamphlet @@ -273,20 +273,80 @@ It used to read: (|initializeTimedNames| |$interpreterTimedNames| |$interpreterTimedClasses|) -(defun |rebuild| (filemode) - "rebuild modemap.daase, exit lisp with bad return code on failure" - (let ((returncode -16)) - (unwind-protect - (let (|$databaseQueue| |$e|) - (declare (special |$databaseQueue| |$e|)) - (|clearConstructorAndLisplibCaches|) - (setq |$databaseQueue| nil) - (setq |$e| (cons (cons nil nil) nil)) - (|buildDatabase| filemode t) - (setq |$IOindex| 1) - (setq |$InteractiveFrame| (cons (cons nil nil) nil)) - (setq returncode 0)) - (unless (zerop returncode) (bye returncode))))) +;buildDatabase(filemode,expensive) == +; $InteractiveMode: local:= true +; $constructorList := nil --looked at by buildLibdb +; $ConstructorCache:= MAKE_-HASHTABLE('ID) +; SAY '"Making constructor autoload" +; makeConstructorsAutoLoad() +; SAY '"Building category table" +; genCategoryTable() +; SAY '"Building libdb.text" +; buildLibdb() +; SAY '"splitting libdb.text" +; dbSplitLibdb() +; SAY '"creating browse constructor index" +; dbAugmentConstructorDataTable() +; SAY '"Building browse.lisp" +; buildBrowsedb() +; SAY '"Building constructor users database" +; mkUsersHashTable() +; SAY '"Saving constructor users database" +; saveUsersHashTable() +; SAY '"Building constructor dependents database" +; mkDependentsHashTable() +; SAY '"Saving constructor dependents database" +; saveDependentsHashTable() +; SAY '"Building glossary files" +; buildGloss() + +;(DEFUN |buildDatabase| (|filemode| |expensive|) +; (declare (ignore |filemode| |expensive|)) +; (PROG (|$InteractiveMode|) +; (DECLARE (SPECIAL |$InteractiveMode| |$ConstructorCache| +; |$constructorList|)) +; (RETURN +; (PROGN +; (SPADLET |$InteractiveMode| 'T) +; (SPADLET |$constructorList| NIL) +; (SPADLET |$ConstructorCache| (MAKE-HASHTABLE 'ID)) +; (SAY "Making constructor autoload") +; (|makeConstructorsAutoLoad|) +; (SAY "Building category table") +; (|genCategoryTable|) +; (SAY "Building libdb.text") +; (|buildLibdb|) +; (SAY "splitting libdb.text") +; (|dbSplitLibdb|) +; (SAY "creating browse constructor index") +; (|dbAugmentConstructorDataTable|) +; (SAY "Building browse.lisp") +; (|buildBrowsedb|) +; (SAY "Building constructor users database") +; (|mkUsersHashTable|) +; (SAY "Saving constructor users database") +; (|saveUsersHashTable|) +; (SAY "Building constructor dependents database") +; (|mkDependentsHashTable|) +; (SAY "Saving constructor dependents database") +; (|saveDependentsHashTable|) +; (SAY "Building glossary files") +; (|buildGloss|))))) +; +;(defun |rebuild| (filemode) +; "rebuild modemap.daase, exit lisp with bad return code on failure" +; (let ((returncode -16)) +; (unwind-protect +; (let (|$databaseQueue| |$e|) +; (declare (special |$databaseQueue| |$e|)) +; (|clearConstructorAndLisplibCaches|) +; (setq |$databaseQueue| nil) +; (setq |$e| (cons (cons nil nil) nil)) +; (|buildDatabase| filemode t) +; (setq |$IOindex| 1) +; (setq |$InteractiveFrame| (cons (cons nil nil) nil)) +; (setq returncode 0)) +; (unless (zerop returncode) (bye returncode))))) (defun boot::|printCopyright| () (format t "there is no such thing as a simple job -- ((iHy))~%"))