aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-10-22 17:15:56 +0000
committerdos-reis <gdr@axiomatics.org>2011-10-22 17:15:56 +0000
commiteaa1adc1cb6ed9ec07ff56614700fe713ba6667c (patch)
treec37aeb6ed1ebfe0adbe0ced27a1402aa4dad043a /src/interp
parent5da95c1b34152d06c776e1c446a51c6703b46cc6 (diff)
downloadopen-axiom-eaa1adc1cb6ed9ec07ff56614700fe713ba6667c.tar.gz
* interp/br-op2.boot (htSayExplicitExports): Don't forget possible
constant marker in exported signatures. * interp/cattable.boot (simpHas): Likewise. * interp/format.boot (form2String1): Likewise. * interp/i-eval.boot (evaluateSignature): Likewise. * interp/i-funsel.boot (hasCaty): Likewise. (hasAttSig): Likewise. * interp/define.boot (extendsCategory): Likewise. (extendsCategoryBasic): Likewise. (catExtendsCat?): Likewise. (mkExportFromDescription): New. (mkCategoryPackage): Use it. * boot/tokens.boot: Add new selectors: mapOpsig, mapOperation, mapPredicate, and mapImpl.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/br-op2.boot2
-rw-r--r--src/interp/cattable.boot2
-rw-r--r--src/interp/define.boot23
-rw-r--r--src/interp/format.boot4
-rw-r--r--src/interp/i-eval.boot4
-rw-r--r--src/interp/i-funsel.boot4
6 files changed, 24 insertions, 15 deletions
diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot
index 298c2fec..3d576881 100644
--- a/src/interp/br-op2.boot
+++ b/src/interp/br-op2.boot
@@ -80,7 +80,7 @@ htSayExplicitExports r ==
htSay '":"
for x in r repeat
htSay '"\newline "
- x is ['SIGNATURE,op,sig] =>
+ x is ['SIGNATURE,op,sig,:.] =>
ops := escapeSpecialChars STRINGIMAGE op
htMakePage [['bcLinks,[ops,'"",'oPage,ops]]]
htSay '": "
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index a5abcce8..74faac7c 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -118,7 +118,7 @@ simpHasPred(pred,:options) == main where
simpDevaluate a == eval substitute('QUOTE,'devaluate,a)
simpHas(pred,a,b) ==
b is ['ATTRIBUTE,attr] => simpHasAttribute(pred,a,attr)
- b is ['SIGNATURE,op,sig] => simpHasSignature(pred,a,op,sig)
+ b is ['SIGNATURE,op,sig,:.] => simpHasSignature(pred,a,op,sig)
ident? a or hasIdent b => pred
npred := evalHas pred
ident? npred or null hasIdent npred => npred
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 23d92eb1..da7c2ed0 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -574,7 +574,8 @@ extendsCategory(dom,u,v,env) ==
v := substSlotNumbers(v,$template,$functorForm)
extendsCategoryBasic(dom,u,v,env) => true
$why :=
- v is ['SIGNATURE,op,sig] => [u,['" has no ",:formatOpSignature(op,sig)]]
+ v is ['SIGNATURE,op,sig,:.] =>
+ [u,['" has no ",:formatOpSignature(op,sig)]]
[u,'" has no",v]
nil
@@ -592,7 +593,7 @@ extendsCategoryBasic(dom,u,v,env) ==
uVec := compMakeCategoryObject(u,env).expr or return false
LASSOC(c,categoryAttributes uVec) is [=true]
isCategoryForm(v,env) => catExtendsCat?(u,v,env)
- v is ['SIGNATURE,op,sig] =>
+ v is ['SIGNATURE,op,sig,:.] =>
uVec := compMakeCategoryObject(u,env).expr or return false
or/[categoryRef(uVec,i) is [[=op,=sig],:.] for i in 6..maxIndex uVec]
u is ['CATEGORY,.,:l] =>
@@ -617,8 +618,8 @@ catExtendsCat?(u,v,env) ==
substSlotNumbers(form,template,domain) ==
form is [op,:.] and
symbolMember?(op,allConstructors()) => expandType(form,template,domain)
- form is ['SIGNATURE,op,sig] =>
- ['SIGNATURE,op,[substSlotNumbers(x,template,domain) for x in sig]]
+ form is ['SIGNATURE,op,sig,:q] =>
+ ['SIGNATURE,op,[substSlotNumbers(x,template,domain) for x in sig],:q]
form is ['CATEGORY,k,:u] =>
['CATEGORY,k,:[substSlotNumbers(x,template,domain) for x in u]]
expandType(form,template,domain)
@@ -964,6 +965,14 @@ makeCategoryPredicates(form,u) ==
for x in u repeat pl := fn(x,pl)
pl
+++ Subroutine of mkCategoryPackage.
+++ Return a category-level declaration of an operation described by `desc'.
+mkExportFromDescription desc ==
+ t :=
+ desc.mapKind = 'CONST => ['constant]
+ nil
+ ['SIGNATURE,desc.mapOperation,desc.mapSignature,:t]
+
mkCategoryPackage(form is [op,:argl],cat,def) ==
catdb := constructorDB op
packageName:= makeDefaultPackageName symbolName op
@@ -977,13 +986,13 @@ mkCategoryPackage(form is [op,:argl],cat,def) ==
packageArgl := [nameForDollar,:argl]
capsuleDefAlist := fn(def,nil) where fn(x,oplist) ==
x isnt [.,:.] => oplist
- x is ['DEF,y,:.] => [y,:oplist]
+ x is ['DEF,y,:.] => [opOf y,:oplist]
fn(x.args,fn(x.op,oplist))
catvec := eval mkEvalableCategoryForm form
fullCatOpList := categoryExports JoinInner([catvec],$e)
catOpList :=
- [['SIGNATURE,op1,sig] for [[op1,sig],:.] in fullCatOpList
- | assoc(op1,capsuleDefAlist)]
+ [mkExportFromDescription desc for desc in fullCatOpList
+ | symbolMember?(desc.mapOperation,capsuleDefAlist)]
null catOpList => nil
packageCategory :=
['CATEGORY,'package,
diff --git a/src/interp/format.boot b/src/interp/format.boot
index a619d7d5..386a85cc 100644
--- a/src/interp/format.boot
+++ b/src/interp/format.boot
@@ -434,7 +434,7 @@ form2String1 u ==
argl' := form2String1 first argl
['"(",:(argl' isnt [.,:.] => [argl']; argl'),'")"]
op = "SIGNATURE" =>
- [operation,sig] := argl
+ [operation,sig,:q] := argl
concat(operation,'": ",formatSignature sig)
op = 'COLLECT => formCollect2String argl
op = 'construct =>
@@ -513,7 +513,7 @@ formatJoinKey(r,key) ==
'"?? unknown mkCategory format ??"
-- otherwise we have the CATEGORY form
"append"/[fn for x in r] where fn() ==
- x is ['SIGNATURE,op,sig] => concat("%l",formatOpSignature(op,sig))
+ x is ['SIGNATURE,op,sig,:.] => concat("%l",formatOpSignature(op,sig))
x is ['ATTRIBUTE,a] => concat("%l",formatAttribute a)
x
diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot
index 0def18d3..5572f087 100644
--- a/src/interp/i-eval.boot
+++ b/src/interp/i-eval.boot
@@ -200,9 +200,9 @@ makeOrdinal i ==
evaluateSignature sig ==
-- calls evaluateType on a signature
- sig is ['SIGNATURE,fun,sigl] =>
+ sig is ['SIGNATURE,fun,sigl,:q] =>
['SIGNATURE,fun,
- [(t = '_$ => t; evaluateType(t)) for t in sigl]]
+ [(t = '_$ => t; evaluateType(t)) for t in sigl],:q]
sig
--% Code Evaluation
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index 513d3a9a..87aa5bb8 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -1472,7 +1472,7 @@ hasCaty(d,cat,SL) ==
-- 2. a list of pairs (argument to cat,condition) otherwise
-- then the substitution SL is augmented, or the result is 'failed
cat is ['CATEGORY,.,:y] => hasAttSig(d,subCopy(y,constructSubst d),SL)
- cat is ['SIGNATURE,foo,sig] =>
+ cat is ['SIGNATURE,foo,sig,:.] =>
hasSig(d,foo,subCopy(sig,constructSubst d),SL)
cat is ['ATTRIBUTE,a] => hasAtt(d,subCopy(a,constructSubst d),SL)
cat is ["Join",:.] =>
@@ -1546,7 +1546,7 @@ hasAttSig(d,x,SL) ==
-- the result is an augmented SL, if d has x, 'failed otherwise
for y in x until SL is 'failed repeat SL:=
y is ['ATTRIBUTE,a] => hasAtt(d,a,SL)
- y is ['SIGNATURE,foo,s] => hasSig(d,foo,s,SL)
+ y is ['SIGNATURE,foo,s,:.] => hasSig(d,foo,s,SL)
keyedSystemError("S2GE0016",
['"hasAttSig",'"unexpected form of unnamed category"])
SL