aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/algebra/domain.spad.pamphlet2
-rw-r--r--src/interp/Makefile.in3
-rw-r--r--src/interp/c-util.boot4
-rw-r--r--src/interp/category.boot14
-rw-r--r--src/interp/database.boot8
-rw-r--r--src/interp/define.boot2
-rw-r--r--src/interp/functor.boot4
-rw-r--r--src/interp/lisplib.boot9
-rw-r--r--src/interp/modemap.boot8
-rw-r--r--src/interp/nruncomp.boot8
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)
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-05 19:23:08 +0000