2008-09-01 Martin Rubey <martin.rubey@univie.ac.at>

	    Gabriel Dos Reis  <gdr@cs.tamu.edu>

	Fix AW/431
	* algebra/ore.spad.pamphlet (SpareUnivariateSkewPolynomial):
	Implement **.

2008-09-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>

	Make ^ an alias for **.
	* interp/postpar.boot (postAtom): Replace "^" with "**".
	* interp/format.boot (reportOpSymbol): Announce that "^" is an
	alias for "**".
	* interp/nrungo.boot (compiledLookup): Be sure to look for "**"
	when operation is "^".
	* interp/define.boot (noteCapsuleFunctionDefinition): New.
	(clearCapsuleFunctionTable): Likewise.
	(noteExport): Likewise.
	(clearExportsTable): Likewise.
	(compDefineCapsuleFunction): Rename "^" to "**".  Take a note
	of the capsule function being compiled.
	(compCapsule): Clear previous capsule functions table.
	(doItIf): Keep track of predicate validity.
	(compCategory): Clear previous exports table.
	(compCategoryItem): Take notes of declared attributes and signatures.
	* algebra/catdef.spad.pamphlet (DivisionRing): Remove duplicate
	definition for "^".
	(Group): Likewise.
	(Monoid): Likewise.
	(SemiGroup): Likewise.
	* algebra/poly.spad.pamphlet (PolynomialRing): Remove duplicate
	definitins of "^".
	(SparseUnivariatePolynomial): Likewise.
	* algebra/multpoly.spad.pamphlet (SparseMultivariatePolynomial):
	Remove duplicate definitions for "^".
	* algebra/interval.spad.pamphlet (Interval): Remove duplicate
	definition for "^".
	* algebra/curve.spad.pamphlet (FunctionFieldCategory): Remove
	duplicate declaration for represents.
	* algebra/strap/: Update cached Lisp translations.
	* share/algebra: Update databases.

4 files changed, 81 insertions, 14 deletions

diff --git a/src/interp/define.boot b/src/interp/define.boot
index ea1e1f91..2d8cbd38 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -53,6 +53,51 @@ $suffix := nil
 -- ??? turns off buggy code
 $NRTopt := false
 
+++ List of operations defined in a given capsule
+++ Each item on this list is of the form
+++    (op sig pred)
+++ where
+++   op:   name of the operation
+++   sig:  signature of the operation
+++   pred: scope predicate of the operation.
+$capsuleFunctions := nil
+
+++ record that the operation `op' with signature `sig' and predicate
+++ `pred' is defined in the current capsule of the current domain
+++ being compiled.
+noteCapsuleFunctionDefinition(op,sig,pred) ==
+  member([op,sig,pred],$capsuleFunctions) =>
+    stackAndThrow('"redefinition of %1b: %2 %3",
+      [op,formatUnabbreviated ["Mapping",:sig],formatIf pred])
+  $capsuleFunctions := [[op,sig,pred],:$capsuleFunctions]
+
+++ Clear the list of functions defined in the last domain capsule.
+clearCapsuleFunctionTable() ==
+  $capsuleFunctions := nil
+
+
+++ List of exports (paireed with scope predicate) declared in
+++ the category of the currend domain or package.
+++ Note: for category packages, this list is nil.
+$exports := nil
+
+noteExport(form,pred) ==
+  -- don't recheck category package exports; we just check
+  -- them when defining the category.  Plus, we might actually
+  -- get indirect duplicates, which is OK.
+  $insideCategoryPackageIfTrue => nil
+  member([form,pred],$exports) =>
+    stackAndThrow('"redeclaration of %1 %2",
+      [form,formatIf pred])
+  $exports := [[form,pred],:$exports]
+
+clearExportsTable() ==
+  $exports := nil
+
+makePredicate l ==
+  null l => true
+  MKPF(l,"and")
+
 --% FUNCTIONS WHICH MUNCH ON == STATEMENTS
 
 compDefine: (%Form,%Mode,%Env) -> %Maybe %Triple 
@@ -842,6 +887,11 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
     $CapsuleDomainsInScope: local:= get("$DomainsInScope","special",e)
     $insideExpressionIfTrue: local:= true
     $returnMode:= m
+    -- Change "^" to "**" in definitions.  All other places have 
+    -- been changed before we get here.
+    if first form = "^" then 
+      sayBrightly ['"Replacing", :bright '"^", '"with",:bright '"**"]
+      rplac(first form,"**")
     [$op,:argl]:= form
     $form:= [$op,:argl]
     argl:= stripOffArgumentConditions argl
@@ -894,6 +944,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
     sayBrightly ['"   compiling ",localOrExported,
       :bright $op,'": ",:formattedSig]
  
+    noteCapsuleFunctionDefinition($op,signature', makePredicate $predl)
     T := CATCH('compCapsuleBody, compOrCroak(body,rettype,e))
 	 or ["",rettype,e]
     NRTassignCapsuleFunctionSlot($op,signature')
@@ -1272,6 +1323,7 @@ compCapsule(['CAPSULE,:itemList],m,e) ==
     [bootStrapError($functorForm, _/EDITFILE),m,e]
   $insideExpressionIfTrue: local:= false
   $useRepresentationHack := true
+  clearCapsuleFunctionTable()
   compCapsuleInner(maybeInsertViewMorphisms itemList,m,addDomain('_$,e))
  
 compSubDomain: (%Form,%Mode,%Env) -> %Maybe %Triple
@@ -1324,7 +1376,8 @@ compCapsuleItems(itemlist,$predl,$e) ==
   $myFunctorBody :local := nil   ---needed for translator
   $signatureOfForm: local := nil
   $suffix: local:= 0
-  for item in itemlist repeat $e:= compSingleCapsuleItem(item,$predl,$e)
+  for item in itemlist repeat 
+    $e:= compSingleCapsuleItem(item,$predl,$e)
   $e
  
 compSingleCapsuleItem(item,$predl,$e) ==
@@ -1412,11 +1465,11 @@ doItIf(item is [.,p,x,y],$predl,$e) ==
   [p',.,$e]:= compCompilerPredicate(p,$e) or userError ['"not a Boolean:",p]
   oldFLP:=$functorLocalParameters
   if x^="%noBranch" then
-    compSingleCapsuleItem(x,$predl,getSuccessEnvironment(p,$e))
+    compSingleCapsuleItem(x,[p,:$predl],getSuccessEnvironment(p,$e))
     x':=localExtras(oldFLP)
   oldFLP:=$functorLocalParameters
   if y^="%noBranch" then
-    compSingleCapsuleItem(y,$predl,getInverseEnvironment(p,olde))
+    compSingleCapsuleItem(y,[["not",p],:$predl],getInverseEnvironment(p,olde))
     y':=localExtras(oldFLP)
   RPLACA(item,"COND")
   RPLACD(item,[[p',x,:x'],['(QUOTE T),y,:y']])
@@ -1503,6 +1556,7 @@ makeCategoryForm(c,e) ==
 compCategory: (%Form,%Mode,%Env) -> %Maybe %Triple 
 compCategory(x,m,e) ==
   $TOP__LEVEL: local:= true
+  clearExportsTable()
   (m:= resolve(m,$Category))=$Category and x is ['CATEGORY,
     domainOrPackage,:l] =>
       $sigList: local := nil
@@ -1572,24 +1626,30 @@ compCategoryItem(x,predl,env) ==
   --1. if x is a conditional expression, recurse; otherwise, form the predicate
   x is ["COND",[p,e]] =>
     predl':= [p,:predl]
-    e is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl',env)
+    e is ["PROGN",:l] =>
+      for y in l repeat compCategoryItem(y,predl',env)
     compCategoryItem(e,predl',env)
   x is ["IF",a,b,c] =>
     predl':= [a,:predl]
     if b^="%noBranch" then
-      b is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl',env)
+      b is ["PROGN",:l] => 
+        for y in l repeat compCategoryItem(y,predl',env)
       compCategoryItem(b,predl',env)
     c="%noBranch" => nil
     predl':= [["not",a],:predl]
-    c is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl',env)
+    c is ["PROGN",:l] => 
+      for y in l repeat compCategoryItem(y,predl',env)
     compCategoryItem(c,predl',env)
-  pred:= (predl => MKPF(predl,"AND"); true)
+  pred := (predl => MKPF(predl,"AND"); true)
  
   --2. if attribute, push it and return
-  x is ["ATTRIBUTE",y] => PUSH(MKQ [y,pred],$atList)
+  x is ["ATTRIBUTE",y] => 
+    noteExport(y,pred)
+    PUSH(MKQ [y,pred],$atList)
  
   --3. it may be a list, with PROGN as the CAR, and some information as the CDR
-  x is ["PROGN",:l] => for u in l repeat compCategoryItem(u,predl,env)
+  x is ["PROGN",:l] => 
+    for u in l repeat compCategoryItem(u,predl,env)
  
 -- 4. otherwise, x gives a signature for a
 --    single operator name or a list of names; if a list of names,
@@ -1604,4 +1664,5 @@ compCategoryItem(x,predl,env) ==
   --4. branch on a single type or a signature %with source and target
   for t in first sig repeat
     diagnoseUknownType(t,env)
+  noteExport(rest x,pred)
   PUSH(MKQ [rest x,pred],$sigList)
diff --git a/src/interp/format.boot b/src/interp/format.boot
index 252eb860..64414ea6 100644
--- a/src/interp/format.boot
+++ b/src/interp/format.boot
@@ -171,6 +171,10 @@ substInOrder(alist,x) ==
   x
 
 reportOpSymbol op1 ==
+  -- Don't forget that "^" is another name for "**"
+  if op1 = "^" then
+    sayMessage ['"  ",op1, '" is another name for", :bright '"**"]
+    op1 := "**"
   op := (STRINGP op1 => INTERN op1; op1)
   modemaps := getAllModemapsFromDatabase(op,nil)
   null modemaps =>
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index 725be391..90497aea 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.boot
@@ -65,6 +65,11 @@ compiledLookup(op,sig,dollar) ==
 --called by coerceByFunction, evalForm, findEqualFun, findUniqueOpInDomain,
 --  getFunctionFromDomain, optDeltaEntry, retractByFunction
   if not VECP dollar then dollar := NRTevalDomain dollar
+  -- "^" is an alternate name for "**" in OpenAxiom libraries.
+  -- ??? When, we get to support Aldor libraries and the equivalence
+  -- ??? does not hold, we may want to do the reverse lookup too.
+  -- ??? See compiledLookupCheck below.
+  if op = "^" then op := "**"
   basicLookup(op,sig,dollar,dollar)
 
 --------------------> NEW DEFINITION (see interop.boot.pamphlet)
@@ -80,12 +85,8 @@ compiledLookupCheck(op,sig,dollar) ==
   fn := compiledLookup(op,sig,dollar)
 
   -- NEW COMPILER COMPATIBILITY ON
-
-  if      (fn = nil)  and (op = "^") then
-    fn := compiledLookup("**",sig,dollar)
-  else if (fn = nil)  and (op = "**") then
+  if (fn = nil)  and (op = "**") then
     fn := compiledLookup("^",sig,dollar)
-
   -- NEW COMPILER COMPATIBILITY OFF
 
   fn = nil =>
diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot
index 9ba73705..23411ef5 100644
--- a/src/interp/postpar.boot
+++ b/src/interp/postpar.boot
@@ -177,6 +177,7 @@ postAtom x ==
   EQ(x,'T) => "T$" -- rename T in spad code to T$
   IDENTP x and niladicConstructorFromDB x => [x]
   x="," => "%Comma"
+  x = "^" => "**"  -- always use `**' internally for exponentiation
   x
 
 postBlock: %ParseTree -> %ParseForm