diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/algebra/domain.spad.pamphlet | 2 | ||||
-rw-r--r-- | src/interp/Makefile.in | 3 | ||||
-rw-r--r-- | src/interp/c-util.boot | 4 | ||||
-rw-r--r-- | src/interp/category.boot | 14 | ||||
-rw-r--r-- | src/interp/database.boot | 8 | ||||
-rw-r--r-- | src/interp/define.boot | 2 | ||||
-rw-r--r-- | src/interp/functor.boot | 4 | ||||
-rw-r--r-- | src/interp/lisplib.boot | 9 | ||||
-rw-r--r-- | src/interp/modemap.boot | 8 | ||||
-rw-r--r-- | src/interp/nruncomp.boot | 8 |
10 files changed, 31 insertions, 31 deletions
diff --git a/src/algebra/domain.spad.pamphlet b/src/algebra/domain.spad.pamphlet index c2d5fedb..6214d34c 100644 --- a/src/algebra/domain.spad.pamphlet +++ b/src/algebra/domain.spad.pamphlet @@ -403,7 +403,7 @@ Category(): Public == Private where exportedOperators c == [%head(x)$Foreign(Builtin)@OperatorSignature - for x in getCategoryExports(c)$Lisp@List(Syntax)] + for x in categoryExports(c)$Lisp@List(Syntax)] principalAncestors c == getCategoryPrincipalAncestors(c)$Lisp diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index ebef3356..74965ecb 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -330,7 +330,8 @@ nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT) define.$(FASLEXT): g-error.$(FASLEXT) modemap.$(FASLEXT) \ nruncomp.$(FASLEXT) database.$(FASLEXT) database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \ - cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT) + cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT) \ + c-util.$(FASLEXT) functor.$(FASLEXT): category.$(FASLEXT) interop.$(FASLEXT) lisplib.$(FASLEXT) category.$(FASLEXT): c-util.$(FASLEXT) g-cndata.$(FASLEXT) cattable.$(FASLEXT): simpbool.$(FASLEXT) g-util.$(FASLEXT) diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 7fd42c62..6f40e699 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -940,9 +940,9 @@ extendsCategoryForm(domain,form,form') == formVec:=(compMakeCategoryObject(form,$e)).expr --Must be $e to pick up locally bound domains form' is ["SIGNATURE",op,args,:.] => - assoc([op,args],formVec.1) or + assoc([op,args],categoryExports formVec) or assoc(substitute(domain,"$",[op,args]), - substitute(domain,"$",formVec.1)) + substitute(domain,"$",categoryExports formVec)) form' is ["ATTRIBUTE",at] => assoc(at,formVec.2) or assoc(substitute(domain,"$",at),substitute(domain,"$",formVec.2)) diff --git a/src/interp/category.boot b/src/interp/category.boot index 63b4fb2e..6407fca9 100644 --- a/src/interp/category.boot +++ b/src/interp/category.boot @@ -67,7 +67,7 @@ CategoryPrint(D,$e) == SAY "Name (and arguments) of category:" PRETTYPRINT canonicalForm D SAY "operations:" - PRETTYPRINT D.1 + PRETTYPRINT categoryExports D SAY "attributes:" PRETTYPRINT D.2 SAY "This is a sub-category of" @@ -136,7 +136,7 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) == -- Build a fresh category object stuffed with all updated information v := newShell count canonicalForm(v) := nil - v.1 := sigList + categoryExports(v) := sigList v.2 := attList v.3 := $Category if PrincipalAncestor ~= nil then @@ -428,7 +428,7 @@ JoinInner(l,$e) == l':= [:CondList,:[[u,true] for u in l]] -- This is a list of all the categories that this extends -- conditionally or unconditionally - sigl:= $NewCatVec.1 + sigl := categoryExports $NewCatVec attl:= $NewCatVec.2 globalDomains:= $NewCatVec.5 FundamentalAncestors:= second $NewCatVec.4 @@ -488,7 +488,7 @@ JoinInner(l,$e) == reallynew:= nil objectMember?(b,l) => --objectMember? since category vectors are guaranteed unique - (sigl:= $NewCatVec.1; attl:= $NewCatVec.2; l:= remove(l,b)) + (sigl:= categoryExports $NewCatVec; attl:= $NewCatVec.2; l:= remove(l,b)) -- SAY("domain ",bname," subsumes") -- SAY("adding a conditional domain ", -- bname, @@ -499,7 +499,7 @@ JoinInner(l,$e) == -- value of bCond not used and could be nil -- bCond:= second bCond globalDomains:= $NewCatVec.5 - for u in $NewCatVec.1 repeat + for u in categoryExports $NewCatVec repeat if not listMember?(u,sigl) then [s,c,i]:= u if c=true @@ -527,7 +527,7 @@ JoinInner(l,$e) == -- in case SigListUnion alters it while -- performing Operator Subsumption for b in l repeat - sigl:= SigListUnion([DropImplementations u for u in b.1],sigl) + sigl:= SigListUnion([DropImplementations u for u in categoryExports b],sigl) attl:= -- next two lines are merely performance improvements symbolMember?(attl,b.2) => b.2 @@ -549,7 +549,7 @@ JoinInner(l,$e) == [[first u,mkOr(second v,mkAnd(newpred,second u))],:attl] sigl:= SigListUnion( - [AddPredicate(DropImplementations u,newpred) for u in (first b).1],sigl) where + [AddPredicate(DropImplementations u,newpred) for u in categoryExports(first b)],sigl) where AddPredicate(op is [sig,oldpred,:implem],newpred) == newpred=true => op oldpred=true => [sig,newpred,:implem] diff --git a/src/interp/database.boot b/src/interp/database.boot index f52e8fcc..7ce512c8 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -34,6 +34,7 @@ import nlib import g_-cndata +import c_-util import clam import cattable import compat @@ -175,7 +176,7 @@ augLisplibModemapsFromCategory(form is [op,:argl],body,signature) == form:= applySubst(sl,form) body:= applySubst(sl,body) signature:= applySubst(sl,signature) - opAlist:= applySubst(sl,vectorRef($domainShell,1)) or return nil + opAlist:= applySubst(sl,categoryExports $domainShell) or return nil nonCategorySigAlist:= mkAlistOfExplicitCategoryOps substitute("*1","$",body) domainList:= @@ -783,11 +784,6 @@ displayHiddenConstructors() == --% -++ Return the list of modemaps exported by the category object `c'. -++ The format of modemap is as found in category objects. -getCategoryExports: %Shell -> %List %Modemap -getCategoryExports c == c.1 - ++ Return the list of category attribute info for the category object `c'. ++ A category attribute info is pair of attribute-predicate. getCategoryAttributes: %Shell -> %List %Form diff --git a/src/interp/define.boot b/src/interp/define.boot index edc5af92..6d3656a6 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1366,7 +1366,7 @@ candidateSignatures(op,nmodes,slot1) == ++ is exported. Return the complete signature if yes; otherwise ++ return nil, with diagnostic in ambiguity case. hasSigInTargetCategory(argl,form,opsig,e) == - sigs := candidateSignatures($op,#form,vectorRef($domainShell,1)) + sigs := candidateSignatures($op,#form,categoryExports $domainShell) cc := checkCallingConvention(sigs,#argl) mList:= [(cc.i > 0 => quasiquote x; getArgumentMode(x,e)) for x in argl for i in 0..] diff --git a/src/interp/functor.boot b/src/interp/functor.boot index a0361b0f..9377aa33 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -318,7 +318,7 @@ setVector12 args == --as in DistributedMultivariatePolynomial args1:=[u.op,:args1] args2:=[u.args,:args2] - freeof($domainShell.1,args1) and + freeof(categoryExports $domainShell,args1) and freeof($domainShell.2,args1) and freeof($domainShell.4,args1) => nil [['SetDomainSlots124,'$,['QUOTE,args1],['%list,:args2]]] @@ -586,7 +586,7 @@ TryGDC cond == SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding" null body => return nil u := first $catvecList - for catImplem in LookUpSigSlots(sig,u.1) repeat + for catImplem in LookUpSigSlots(sig,categoryExports u) repeat catImplem is [q,.,index] and (q='ELT or q='CONST) => if q is 'CONST and body is ['CONS,a,b] then body := ['CONS,'IDENTITY,['FUNCALL,a,b]] diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 476d7548..7ba8c45b 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -673,7 +673,7 @@ getSlot1 domainName == $e:= put(a,'mode,m,$e) t := compMakeCategoryObject(target,$e) or systemErrorHere ["getSlot1",domainName] - t.expr.1 + categoryExports t.expr sayKeyedMsg("S2IL0022",[namestring p,'"constructor modemap"]) nil @@ -713,11 +713,12 @@ sayNonUnique x == -- [:[[op,:x] for x in y] for [op,:y] in operationAlist] findConstructorSlotNumber(domainForm,domain,op,sig) == - null domain.1 => getSlotNumberFromOperationAlist(domainForm,op,sig) + null categoryExports domain => + getSlotNumberFromOperationAlist(domainForm,op,sig) sayMSG ['" using slot 1 of ",domainForm] constructorArglist:= rest domainForm nsig:=#sig - tail:= or/[r for [[op1,sig1],:r] in domain.1 | op=op1 and nsig=#sig1 and + tail:= or/[r for [[op1,sig1],:r] in categoryExports domain | op=op1 and nsig=#sig1 and "and"/[compare for a in sig for b in sig1]] where compare() == a=b => true integer? b => a=constructorArglist.b @@ -755,7 +756,7 @@ sigsMatch(sig,sig1,domainForm) == findDomainSlotNumber(domain,op,sig) == --using slot 1 of the domain nsig:=#sig - tail:= or/[r for [[op1,sig1],:r] in domain.1 | op=op1 and nsig=#sig1 and + tail:= or/[r for [[op1,sig1],:r] in categoryExports domain | op=op1 and nsig=#sig1 and "and"/[a=b or isSubset(bustUnion a,bustUnion b,$CategoryFrame) for a in sig for b in sig1]] tail is [.,["ELT",.,n]] => n diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index ce3b64cc..38c00d28 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -313,7 +313,8 @@ augModemapsFromCategory(domainName,domainView,functorForm,categoryForm,e) == evalAndSub(domainName,viewName,functorForm,form,$e) == $lhsOfColon: local:= domainName - categoryObject? form => [substNames(domainName,viewName,functorForm,form.1),$e] + categoryObject? form => + [substNames(domainName,viewName,functorForm,categoryExports form),$e] --next lines necessary-- see MPOLY for which $ is actual arg. --- RDJ 3/83 if CONTAINED("$$",form) then $e:= put("$$","mode",get("$","mode",$e),$e) opAlist:= getOperationAlist(domainName,functorForm,form) @@ -327,8 +328,9 @@ getOperationAlist(name,functorForm,form) == (u:= isFunctor functorForm) and not ($insideFunctorIfTrue and first functorForm=first $functorForm) => u $insideFunctorIfTrue and name="$" => - ($domainShell => $domainShell.1; systemError '"$ has no shell now") - T:= compMakeCategoryObject(form,$e) => ([.,.,$e]:= T; T.expr.1) + $domainShell => categoryExports $domainShell + systemError '"$ has no shell now" + T:= compMakeCategoryObject(form,$e) => ([.,.,$e]:= T; categoryExports T.expr) stackMessage('"not a category form: %1bp",[form]) substNames(domainName,viewName,functorForm,opalist) == diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index f176beee..c0c14683 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -320,7 +320,7 @@ NRTaddInner x == NRTisExported? opSig == - or/[u for u in $domainShell.1 | u.0 = opSig] + or/[u for u in categoryExports $domainShell | u.0 = opSig] consOpSig(op,sig,dc) == if cons? op then @@ -633,7 +633,7 @@ NRTmakeSlot1Info() == [[dollarName,:'_$],:mkSlot1sublis argl] mkSlot1sublis rest $form $lisplibOpAlist := - transformOperationAlist applySubst(pairlis,vectorRef($domainShell,1)) + transformOperationAlist applySubst(pairlis,categoryExports $domainShell) opList := $NRTderivedTargetIfTrue => 'derived $insideCategoryPackageIfTrue => slot1Filter $lisplibOpAlist @@ -674,7 +674,7 @@ changeDirectoryInSlot1() == --called by buildFunctor -- if called inside buildFunctor, $NRTdeltaLength gives different locs -- otherwise called from compFunctorBody (all lookups are forwarded): -- $NRTdeltaList = nil ===> all slot numbers become nil - $lisplibOperationAlist := [sigloc entry for entry in $domainShell.1] where + $lisplibOperationAlist := [sigloc entry for entry in categoryExports $domainShell] where sigloc [opsig,pred,fnsel] == if pred isnt 'T then pred := simpBool pred @@ -688,7 +688,7 @@ changeDirectoryInSlot1() == --called by buildFunctor copyList $lisplibOperationAlist,function second) $lastPred: local := false $newEnv: local := $e - vectorRef($domainShell,1) := [fn entry for entry in sortedOplist] where + categoryExports($domainShell) := [fn entry for entry in sortedOplist] where fn [[op,sig],pred,fnsel] == if $lastPred ~= pred then $newEnv := deepChaseInferences(pred,$e) |