diff options
author | dos-reis <gdr@axiomatics.org> | 2011-10-22 17:15:56 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-10-22 17:15:56 +0000 |
commit | eaa1adc1cb6ed9ec07ff56614700fe713ba6667c (patch) | |
tree | c37aeb6ed1ebfe0adbe0ced27a1402aa4dad043a /src/interp | |
parent | 5da95c1b34152d06c776e1c446a51c6703b46cc6 (diff) | |
download | open-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.boot | 2 | ||||
-rw-r--r-- | src/interp/cattable.boot | 2 | ||||
-rw-r--r-- | src/interp/define.boot | 23 | ||||
-rw-r--r-- | src/interp/format.boot | 4 | ||||
-rw-r--r-- | src/interp/i-eval.boot | 4 | ||||
-rw-r--r-- | src/interp/i-funsel.boot | 4 |
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 |