diff options
| -rw-r--r-- | src/interp/database.boot (renamed from src/interp/database.boot.pamphlet) | 154 |
1 files changed, 65 insertions, 89 deletions
diff --git a/src/interp/database.boot.pamphlet b/src/interp/database.boot index 03c15cd2..20b1df7c 100644 --- a/src/interp/database.boot.pamphlet +++ b/src/interp/database.boot @@ -1,22 +1,7 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/database.boot} Pamphlet} -\author{The Axiom Team} - -\begin{document} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject - -\section{License} - -<<license>>= -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. +-- Copyright (C) 2007, Gabriel Dos Reis. +-- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are @@ -46,9 +31,6 @@ -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> import '"nlib" import '"g-cndata" @@ -79,7 +61,7 @@ augLisplibModemapsFromCategory(form is [op,:argl],body,signature) == pred':= MKPF([pred,:catPredList],'AND) modemap:= [["*1",:sig],[pred',sel]] $lisplibModemapAlist:= - [[op,:interactiveModemapForm modemap],:$lisplibModemapAlist] + [[op,:interactiveModemapForm modemap],:$lisplibModemapAlist] augmentLisplibModemapsFromFunctor(form,opAlist,signature) == form:= [formOp,:argl]:= formal2Pattern form @@ -95,30 +77,30 @@ augmentLisplibModemapsFromFunctor(form,opAlist,signature) == for (entry:= [[op,sig,:.],pred,sel]) in opAlist | or/[(sig in catSig) for catSig in allLASSOCs(op,nonCategorySigAlist)] repeat - skip:= - argl and CONTAINED("$",rest sig) => 'SKIP - nil - sel:= substitute(form,"$",sel) - patternList:= listOfPatternIds sig - --get relevant predicates - predList:= - [[a,m] for a in argl for m in rest signature - | MEMQ(a,$PatternVariableList)] - sig:= substitute(form,"$",sig) - pred':= MKPF([pred,:[mkDatabasePred y for y in predList]],'AND) - l:=listOfPatternIds predList - if "OR"/[null MEMQ(u,l) for u in argl] then - sayMSG ['"cannot handle modemap for",:bright op, - '"by pattern match" ] - skip:= 'SKIP - modemap:= [[form,:sig],[pred',sel,:skip]] - $lisplibModemapAlist:= [[op,:interactiveModemapForm modemap], - :$lisplibModemapAlist] + skip:= + argl and CONTAINED("$",rest sig) => 'SKIP + nil + sel:= substitute(form,"$",sel) + patternList:= listOfPatternIds sig + --get relevant predicates + predList:= + [[a,m] for a in argl for m in rest signature + | MEMQ(a,$PatternVariableList)] + sig:= substitute(form,"$",sig) + pred':= MKPF([pred,:[mkDatabasePred y for y in predList]],'AND) + l:=listOfPatternIds predList + if "OR"/[null MEMQ(u,l) for u in argl] then + sayMSG ['"cannot handle modemap for",:bright op, + '"by pattern match" ] + skip:= 'SKIP + modemap:= [[form,:sig],[pred',sel,:skip]] + $lisplibModemapAlist:= [[op,:interactiveModemapForm modemap], + :$lisplibModemapAlist] rebuildCDT(filemode) == clearConstructorAndLisplibCaches() $databaseQueue:local :=nil - $e: local := [[NIL]] -- We may need to evaluate Categories + $e: local := [[NIL]] -- We may need to evaluate Categories buildDatabase(filemode,false) $IOindex:= 1 $InteractiveFrame:= [[NIL]] @@ -126,7 +108,7 @@ rebuildCDT(filemode) == buildDatabase(filemode,expensive) == $InteractiveMode: local:= true - $constructorList := nil --looked at by buildLibdb + $constructorList := nil --looked at by buildLibdb $ConstructorCache:= MAKE_-HASHTABLE('ID) SAY '"Making constructor autoload" makeConstructorsAutoLoad() @@ -196,14 +178,14 @@ orderPredicateItems(pred1,sig,skip) == 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 ..) + ----- (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] + (^skip and pred is ['isDomain,pvar,.] and pvar="*1")) => + oldList:=delete(pred,oldList) + lastPreds:=[pred,:lastPreds] --sayBrightlyNT "lastPreds=" --pp lastPreds @@ -228,7 +210,7 @@ orderPredTran(oldList,sig,skip) == indepvl := listOfPatternIds x depvl := nil (INTERSECTIONQ(indepvl,dependList) = nil) - and INTERSECTIONQ(indepvl,lastDependList) => + and INTERSECTIONQ(indepvl,lastDependList) => somethingDone := true lastPreds := [:lastPreds,x] oldList := delete(x,oldList) @@ -242,14 +224,14 @@ orderPredTran(oldList,sig,skip) == 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 + indepvl:=listOfPatternIds v + depvl:=listOfPatternIds body else - indepvl := listOfPatternIds x - depvl := nil + indepvl := listOfPatternIds x + depvl := nil (INTERSECTIONQ(indepvl,dependList) = nil) => - dependList:= setDifference(dependList,depvl) - newList:= [:newList,x] + dependList:= setDifference(dependList,depvl) + newList:= [:newList,x] -- sayBrightlyNT "newList=" -- pp newList @@ -266,7 +248,7 @@ orderPredTran(oldList,sig,skip) == 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:= insertWOC(x,fullDependList) fullDependList:= UNIONQ(fullDependList,ids) newList:=[:newList,:lastPreds] @@ -281,8 +263,8 @@ isDomainSubst u == main where main() == u is [head,:tail] => nhead := - head is ['isDomain,x,y] => ['isDomain,x,fn(y,tail)] - head + head is ['isDomain,x,y] => ['isDomain,x,fn(y,tail)] + head [nhead,:isDomainSubst rest u] u fn(x,alist) == @@ -404,7 +386,7 @@ getDomainFromMm mm == if cond is ['partial, :c] then cond := c condList := cond is ['AND, :cl] => cl - cond is ['OR, ['AND, :cl],:.] => cl --all cl's should give same info + cond is ['OR, ['AND, :cl],:.] => cl --all cl's should give same info [cond] val := for condition in condList repeat @@ -424,7 +406,7 @@ getFirstArgTypeFromMm mm == if cond is ['partial, :c] then cond := c condList := cond is ['AND, :cl] => cl - cond is ['OR, ['AND, :cl],:.] => cl --all cl's should give same info + cond is ['OR, ['AND, :cl],:.] => cl --all cl's should give same info [cond] type := nil for condition in condList while not type repeat @@ -443,7 +425,7 @@ isFreeFunctionFromMmCond cond == if cond is ['partial, :c] then cond := c condList := cond is ['AND, :cl] => cl - cond is ['OR, ['AND, :cl],:.] => cl --all cl's should give same info + cond is ['OR, ['AND, :cl],:.] => cl --all cl's should give same info [cond] iff := false for condition in condList while not iff repeat @@ -470,7 +452,7 @@ getSystemModemaps(op,nargs) == for (x := [[.,:sig],.]) in mml repeat (NUMBERP nargs) and (nargs ^= #QCDR sig) => 'iterate $getUnexposedOperations or isFreeFunctionFromMm(x) or - isExposedConstructor(getDomainFromMm(x)) => mms := [x,:mms] + isExposedConstructor(getDomainFromMm(x)) => mms := [x,:mms] 'iterate mms nil @@ -480,8 +462,8 @@ getInCoreModemaps(modemapList,op,nargs) == mml:= CAR mml [x for (x:= [[dc,:sig],.]) in mml | (NUMBERP nargs => nargs=#rest sig; true) and - (cfn := abbreviate (domName := getDomainFromMm x)) and - ($getUnexposedOperations or isExposedConstructor(domName))] + (cfn := abbreviate (domName := getDomainFromMm x)) and + ($getUnexposedOperations or isExposedConstructor(domName))] nil mkAlistOfExplicitCategoryOps target == @@ -493,16 +475,16 @@ mkAlistOfExplicitCategoryOps target == l:= flattenSignatureList ['PROGN,:l] u:= [[atomizeOp op,:sig] for x in l | x is ['SIGNATURE,op,sig,:.]] - where - atomizeOp op == - atom op => op - op is [a] => a - keyedSystemError("S2GE0016", - ['"mkAlistOfExplicitCategoryOps",'"bad signature"]) + where + atomizeOp op == + atom op => op + op is [a] => a + keyedSystemError("S2GE0016", + ['"mkAlistOfExplicitCategoryOps",'"bad signature"]) opList:= REMDUP ASSOCLEFT u [[x,:fn(x,u)] for x in opList] where fn(op,u) == - u is [[a,:b],:c] => (a=op => [b,:fn(op,c)]; fn(op,c)) + u is [[a,:b],:c] => (a=op => [b,:fn(op,c)]; fn(op,c)) isCategoryForm(target,$e) => nil keyedSystemError("S2GE0016", ['"mkAlistOfExplicitCategoryOps",'"bad signature"]) @@ -515,8 +497,8 @@ flattenSignatureList(x) == x is ['PROGN,:l] => ll:= [] for x in l repeat - x is ['SIGNATURE,:.] => ll:=cons(x,ll) - ll:= append(flattenSignatureList x,ll) + x is ['SIGNATURE,:.] => ll:=cons(x,ll) + ll:= append(flattenSignatureList x,ll) ll nil @@ -576,16 +558,16 @@ loadDependents fn == l:= rread('dependents,stream,nil) RSHUT stream for x in l repeat - x='SubDomain => nil - loadIfNecessary x + x='SubDomain => nil + loadIfNecessary x --% Miscellaneous Stuff getOplistForConstructorForm (form := [op,:argl]) == -- The new form is an op-Alist which has entries (<op> . signature-Alist) - -- where signature-Alist has entries (<signature> . item) - -- where item has form (<slotNumber> <condition> <kind>) - -- where <kind> = ELT | CONST | Subsumed | (XLAM..) .. + -- where signature-Alist has entries (<signature> . item) + -- where item has form (<slotNumber> <condition> <kind>) + -- where <kind> = ELT | CONST | Subsumed | (XLAM..) .. pairlis:= [[fv,:arg] for fv in $FormalMapVariableList for arg in argl] opAlist := getOperationAlistFromLisplib op [:getOplistWithUniqueSignatures(op,pairlis,signatureAlist) @@ -595,8 +577,8 @@ getOplistWithUniqueSignatures(op,pairlis,signatureAlist) == alist:= nil for [sig,:[slotNumber,pred,kind]] in signatureAlist | kind ^= 'Subsumed repeat alist:= insertAlist(SUBLIS(pairlis,[op,sig]), - SUBLIS(pairlis,[pred,[kind,nil,slotNumber]]), - alist) + SUBLIS(pairlis,[pred,[kind,nil,slotNumber]]), + alist) alist --% Code For Modemap Insertion @@ -624,21 +606,21 @@ dropPrefix(fn) == --++ egFiles := NIL --++ while (not PLACEP (x:= READ_-LINE stream)) repeat --++ x := DROPTRAILINGBLANKS x ---++ SIZE(x) = 0 => 'iterate -- blank line +--++ SIZE(x) = 0 => 'iterate -- blank line --++ (x.0 = char "#") or (x.0 = char "*") => 'iterate -- comment --++ x.0 = char " " => --++ -- possible exposure group member name and library name --++ null egName => ---++ throwKeyedMsg("S2IZ0069A",[namestring egFile,x]) +--++ throwKeyedMsg("S2IZ0069A",[namestring egFile,x]) --++ x := dropLeadingBlanks x --++ -- should be two tokens on the line --++ p := STRPOS('" ",x,1,NIL) --++ NULL p => ---++ throwKeyedMsg("S2IZ0069B",[namestring egFile,x]) +--++ throwKeyedMsg("S2IZ0069B",[namestring egFile,x]) --++ n := object2Identifier SUBSTRING(x,0,p) --++ x := dropLeadingBlanks SUBSTRING(x,p+1,NIL) --++ SIZE(x) = 0 => ---++ throwKeyedMsg("S2IZ0069B",[namestring egFile,x]) +--++ throwKeyedMsg("S2IZ0069B",[namestring egFile,x]) --++ egFiles := [[n,:object2Identifier x],:egFiles] --++ -- have a new group name --++ if egName then $globalExposureGroupAlist := @@ -696,9 +678,3 @@ displayHiddenConstructors() == centerAndHighlight c -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} |