From eaa1adc1cb6ed9ec07ff56614700fe713ba6667c Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sat, 22 Oct 2011 17:15:56 +0000
Subject: 	* 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.

---
 src/interp/define.boot | 23 ++++++++++++++++-------
 1 file changed, 16 insertions(+), 7 deletions(-)

(limited to 'src/interp/define.boot')

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,
-- 
cgit v1.2.3