diff options
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/br-op1.boot | 2 | ||||
-rw-r--r-- | src/interp/br-op2.boot | 2 | ||||
-rw-r--r-- | src/interp/database.boot | 34 | ||||
-rw-r--r-- | src/interp/define.boot | 2 | ||||
-rw-r--r-- | src/interp/i-analy.boot | 2 | ||||
-rw-r--r-- | src/interp/i-coerce.boot | 2 | ||||
-rw-r--r-- | src/interp/i-funsel.boot | 10 | ||||
-rw-r--r-- | src/interp/i-spec2.boot | 2 | ||||
-rw-r--r-- | src/interp/lisplib.boot | 3 | ||||
-rw-r--r-- | src/interp/nrunopt.boot | 2 | ||||
-rw-r--r-- | src/interp/trace.boot | 3 |
11 files changed, 15 insertions, 49 deletions
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 16c769a7..169175ba 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -934,7 +934,7 @@ getDomainOpTable(dom,fromIfTrue,:options) == domname := dom.0 conname := first domname abb := getConstructorAbbreviation conname - opAlist := getOperationAlistFromLisplib conname + opAlist := getConstructorOperationsFromDB conname "append"/[removeDuplicates [[op1,:fn] for [sig,slot,pred,key,:.] in u | key ~= 'Subsumed and ((null ops and (op1 := op)) or (op1 := memq(op,ops)))] for [op,:u] in opAlist] where diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index 837adb90..15453e12 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -399,7 +399,7 @@ koOps(conform,domname,:options) == main where null $packageItem => '(NIL NIL) isExposedConstructor opOf conform => [conform,:'(T)] [conform,:'(NIL)] - for [op,:u] in getOperationAlistFromLisplib conname repeat + for [op,:u] in getConstructorOperationsFromDB conname repeat op1 := zeroOneConvert op acc := [[op1,:[[sig,npred,:exposureTail] for [sig,slot,pred,key,:.] in sublisFormal(subargs,u) | diff --git a/src/interp/database.boot b/src/interp/database.boot index 6f597615..040f5cb6 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -671,45 +671,13 @@ loadDependents fn == --% Miscellaneous Stuff -markUnique x == - u := first x - x.first := '(_$unique) - x.rest := [u,:rest x] - rest x - -++ Tail of most function descriptors. -$FunctionDescriptorTail == '(NIL T ELT) - -++ Return the list of overload sets of operations exported by -++ the constructor `x'. This function differs from -++ getConstructorOperationsFromDB in that it uncompresses the -++ common tail of most function descriptors. That compression -++ was done when the overload sets were saved in the -++ operation database. -getOperationAlistFromLisplib x == - u := getConstructorOperationsFromDB x --- u := removeZeroOneDestructively u - null u => u -- this can happen for Object - CAAR u = '_$unique => rest u - f:= $FunctionDescriptorTail - for [op,:sigList] in u repeat - for items in tails sigList repeat - [sig,:r] := first items - if r is [.,:s] then - if s is [.,:t] then - if t is [.] then nil - else s.rest := QCDDR f - else r.rest := rest f - else items.first.rest := f - u and markUnique u - 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..) .. pairlis := pairList($FormalMapVariableList,argl) - opAlist := getOperationAlistFromLisplib op + opAlist := getConstructorOperationsFromDB op [:getOplistWithUniqueSignatures(op,pairlis,signatureAlist) for [op,:signatureAlist] in opAlist] diff --git a/src/interp/define.boot b/src/interp/define.boot index 5b73b5d9..350a5eb9 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -884,7 +884,7 @@ genDomainViewList(id,catlist) == mkOpVec(dom,siglist) == dom:= getPrincipalView dom substargs:= [['$,:dom.0],:pairList($FormalMapVariableList,rest dom.0)] - oplist:= getOperationAlistFromLisplib opOf dom.0 + oplist:= getConstructorOperationsFromDB opOf dom.0 --new form is (<op> <signature> <slotNumber> <condition> <kind>) ops:= MAKE_-VEC (#siglist) for (opSig:= [op,sig]) in siglist for i in 0.. repeat diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index 6dcf0421..4cb9bbe5 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -390,7 +390,7 @@ namedConstant(id,t) == doms := [getDCFromSystemModemap sysmm for sysmm in sysmms] candidates := nil for dc in doms | niladicConstructorFromDB first dc repeat - LASSOC(id,getOperationAlistFromLisplib first dc) is [[sig,.,.,"CONST"]] => + LASSOC(id,getConstructorOperationsFromDB dc.op) is [[sig,.,.,"CONST"]] => candidates := [[dc,sig],:candidates] null candidates => nil #candidates = 1 => diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index 1ede612a..1bf238fd 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -328,7 +328,7 @@ retractByFunction(object,u) == getConstantFromDomain(form,domainForm) == isPartialMode domainForm => NIL - opAlist := getOperationAlistFromLisplib first domainForm + opAlist := getConstructorOperationsFromDB domainForm.op key := opOf form entryList := LASSOC(key,opAlist) entryList isnt [[sig, ., ., .]] => diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 0c3acb0a..51b3ccde 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -690,7 +690,7 @@ getFunctionFromDomain(op,dc,args) == isOpInDomain(opName,dom,nargs) == -- returns true only if there is an op in the given domain with -- the given number of arguments - mmList := ASSQ(opName,getOperationAlistFromLisplib first dom) + mmList := ASSQ(opName,getConstructorOperationsFromDB dom.op) mmList := subCopy(mmList,constructSubst dom) null mmList => NIL gotOne := NIL @@ -705,7 +705,7 @@ findCommonSigInDomain(opName,dom,nargs) == -- a "signature" where a type position is non-NIL only if all -- signatures shares that type . first(dom) in '(Union Record Mapping) => NIL - mmList := ASSQ(opName,getOperationAlistFromLisplib first dom) + mmList := ASSQ(opName,getConstructorOperationsFromDB dom.op) mmList := subCopy(mmList,constructSubst dom) null mmList => NIL gotOne := NIL @@ -720,7 +720,7 @@ findCommonSigInDomain(opName,dom,nargs) == findUniqueOpInDomain(op,opName,dom) == -- return function named op in domain dom if unique, choose one if not - mmList := ASSQ(opName,getOperationAlistFromLisplib first dom) + mmList := ASSQ(opName,getConstructorOperationsFromDB dom.op) mmList := subCopy(mmList,constructSubst dom) null mmList => throwKeyedMsg("S2IS0021",[opName,dom]) @@ -792,7 +792,7 @@ findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) == findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) NIL fun:= NIL - ( p := ASSQ(op,getOperationAlistFromLisplib dcName) ) and + ( p := ASSQ(op,getConstructorOperationsFromDB dcName) ) and SL := constructSubst dc -- if the arglist is homogeneous, first look for homogeneous -- functions. If we don't find any, look at remaining ones @@ -1586,7 +1586,7 @@ hasSig(dom,foo,sig,SL) == $domPvar: local := nil fun:= constructor? first dom => S0:= constructSubst dom - p := ASSQ(foo,getOperationAlistFromLisplib first dom) => + p := ASSQ(foo,getConstructorOperationsFromDB dom.op) => for [x,.,cond,.] in rest p until not (S='failed) repeat S:= atom cond => copy SL diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot index c67ccb7e..e8522eb9 100644 --- a/src/interp/i-spec2.boot +++ b/src/interp/i-spec2.boot @@ -84,7 +84,7 @@ upDEF t == ++ <%Mode>: the type of the constant. ++ T: too many constants designated by `form'. constantInDomain?(form,domainForm) == - opAlist := getOperationAlistFromLisplib first domainForm + opAlist := getConstructorOperationsFromDB domainForm.op key := opOf form entryList := [entry for (entry := [.,.,.,k]) in LASSOC(key,opAlist) | k in '(CONST ASCONST)] diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 6af66112..d3f3d775 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -545,9 +545,6 @@ transformOperationAlist operationAlist == keyedSystemError("S2IL0025",[implementation]) signatureItem:= if u:= assoc([op,sig],$functionLocations) then n := [n,:rest u] - kind = 'ELT => - condition = 'T => [sig,n] - [sig,n,condition] [sig,n,condition,kind] itemList:= [signatureItem,:LASSQ(op,newAlist)] newAlist:= insertAlist(op,itemList,newAlist) diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index 9457e2e4..f04d56ef 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -786,7 +786,7 @@ dcAll con == 'done dcOps conname == - for [op,:u] in reverse getOperationAlistFromLisplib conname repeat + for [op,:u] in reverse getConstructorOperationsFromDB conname repeat for [sig,slot,pred,key,:.] in u repeat suffix := atom pred => nil diff --git a/src/interp/trace.boot b/src/interp/trace.boot index ebb04541..28a50610 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -441,7 +441,8 @@ spadTrace(domain,options) == domainId:= opOf domain.0 currentEntry:= assoc(domain,_/TRACENAMES) currentAlist:= KDR currentEntry - opStructureList:= flattenOperationAlist getOperationAlistFromLisplib domainId + opStructureList := + flattenOperationAlist getConstructorOperationsFromDB domainId sigSlotNumberAlist:= [triple --new form is (<op> <signature> <slotNumber> <condition> <kind>) |