From d25e6afd1bed18994110266ad184b265f0ee0271 Mon Sep 17 00:00:00 2001
From: Tim Daly <daly@axiom-developer.org>
Date: Tue, 4 Aug 2015 10:30:00 -0400
Subject: [PATCH] books/bookvol10.* add COQ stanzas

Goal: Proving Axiom Correct

Stanzas were added to the algebra that contain the executable code
with associated signatures. These stanzas are automatically extracted
to the obj/sys/proofs/coq.v file. This file is piped through coqtop
to run the proofs.

Building stanzas is not complete but is (maybe) sufficient to construct
a first proof.
---
 books/Makefile.pamphlet    |    7 +-
 books/bookvol10.2.pamphlet |19616 ++++++++++++++++++++++++++++++++++++--------
 books/bookvol10.3.pamphlet | 8706 +++++++++++++++++++-
 books/bookvol10.4.pamphlet | 4696 +++++++++++-
 books/bookvolbib.pamphlet  |   29 +-
 5 files changed, 29523 insertions(+), 3531 deletions(-)

diff --git a/books/Makefile.pamphlet b/books/Makefile.pamphlet
index 76a54f4..3091e6b 100644
--- a/books/Makefile.pamphlet
+++ b/books/Makefile.pamphlet
@@ -71,11 +71,12 @@ ${PROOFS}/coq.lisp:
 	@ echo ===========================================
 	@ echo making ${PROOFS}/coq.lisp
 	@ echo ===========================================
-	@ ${BOOKS}/tanglec ${BOOKS}/bookvol10.2.pamphlet coq \
-             >${PROOFS}/coq.lisp
+	@ ${BOOKS}/tanglec ${BOOKS}/bookvol10.2.pamphlet coq >${PROOFS}/coq.v
+	@ ${BOOKS}/tanglec ${BOOKS}/bookvol10.3.pamphlet coq >>${PROOFS}/coq.v
+	@ ${BOOKS}/tanglec ${BOOKS}/bookvol10.4.pamphlet coq >>${PROOFS}/coq.v
 	@ if [ .${COQ} = .coq ] ; \
 	   then \
-	    ( cd ${PROOFS} ; echo "Insert COQ commands here" >coq.lisp ) ; \
+	    ( cd ${PROOFS} ; cat coq.v | coqtop >coq.console 2>&1 ) ; \
 	   fi ; 
 
 ${PDF}/axiom.bib:
diff --git a/books/bookvol10.2.pamphlet b/books/bookvol10.2.pamphlet
index 03c8a4b..a8f2a63 100644
--- a/books/bookvol10.2.pamphlet
+++ b/books/bookvol10.2.pamphlet
@@ -100,11 +100,13 @@ This is the root of the category hierarchy and is not represented by code.
  [color=lightblue,href="bookvol10.2.pdf#nameddest=CATEGORY"];
 
 \end{chunk}
+
 \begin{chunk}{CATEGORY.dotfull}
 "Category"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=CATEGORY"];
 
 \end{chunk}
+
 \begin{chunk}{CATEGORY.dotpic}
 digraph pic {
  fontsize=10;
@@ -115,9 +117,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{AdditiveValuationAttribute}{ATADDVA}
 \pagepic{ps/v102additivevaluationattribute.eps}{ATADDVA}{1.00}
+
 \begin{chunk}{AdditiveValuationAttribute.input}
 )set break resume
 )sys rm -f AdditiveValuationAttribute.output
@@ -148,6 +152,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{AdditiveValuationAttribute.help}
 ====================================================================
 AdditiveValuationAttribute 
@@ -170,18 +175,21 @@ o )show AdditiveValuationAttribute
 AdditiveValuationAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATADDVA.dotabb}
 "ATADDVA"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATADDVA"];
 "ATADDVA" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATADDVA.dotfull}
 "AdditiveValuationAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATADDVA"];
 "AdditiveValuationAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATADDVA.dotpic}
 digraph pic {
  fontsize=10;
@@ -195,9 +203,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ApproximateAttribute}{ATAPPRO}
 \pagepic{ps/v102approximateattribute.eps}{ATAPPRO}{1.00}
+
 \begin{chunk}{ApproximateAttribute.input}
 )set break resume
 )sys rm -f ApproximateAttribute.output
@@ -229,6 +239,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{ApproximateAttribute.help}
 ====================================================================
 ApproximateAttribute 
@@ -249,18 +260,21 @@ o )show ApproximateAttribute
 ApproximateAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATAPPRO.dotabb}
 "ATAPPRO"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATAPPRO"];
 "ATAPPRO" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATAPPRO.dotfull}
 "ApproximateAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATAPPRO"];
 "ApproximateAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATAPPRO.dotpic}
 digraph pic {
  fontsize=10;
@@ -274,9 +288,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ArbitraryExponentAttribute}{ATARBEX}
 \pagepic{ps/v102arbitraryexponentattribute.eps}{ATARBEX}{1.00}
+
 \begin{chunk}{ArbitraryExponentAttribute.input}
 )set break resume
 )sys rm -f ArbitraryExponentAttribute.output
@@ -308,6 +324,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{ArbitraryExponentAttribute.help}
 ====================================================================
 ArbitraryExponentAttribute 
@@ -328,18 +345,21 @@ o )show ArbitraryExponentAttribute
 ArbitraryExponentAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATARBEX.dotabb}
 "ATARBEX"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATARBEX"];
 "ATARBEX" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATARBEX.dotfull}
 "ArbitraryExponentAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATARBEX"];
 "ArbitraryExponentAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATARBEX.dotpic}
 digraph pic {
  fontsize=10;
@@ -353,9 +373,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ArbitraryPrecisionAttribute}{ATARBPR}
 \pagepic{ps/v102arbitraryprecisionattribute.eps}{ATARBPR}{1.00}
+
 \begin{chunk}{ArbitraryPrecisionAttribute.input}
 )set break resume
 )sys rm -f ArbitraryPrecisionAttribute.output
@@ -387,6 +409,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{ArbitraryPrecisionAttribute.help}
 ====================================================================
 ArbitraryPrecisionAttribute 
@@ -409,18 +432,21 @@ o )show ArbitraryPrecisionAttribute
 ArbitraryPrecisionAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATARBPR.dotabb}
 "ATARBPR"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATARBPR"];
 "ATARBPR" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATARBPR.dotfull}
 "ArbitraryPrecisionAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATARBPR"];
 "ArbitraryPrecisionAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATARBPR.dotpic}
 digraph pic {
  fontsize=10;
@@ -434,9 +460,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ArcHyperbolicFunctionCategory}{AHYP}
 \pagepic{ps/v102archyperbolicfunctioncategory.ps}{AHYP}{1.00}
+
 \begin{chunk}{ArcHyperbolicFunctionCategory.input}
 )set break resume
 )sys rm -f ArcHyperbolicFunctionCategory.output
@@ -463,6 +491,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ArcHyperbolicFunctionCategory.help}
 ====================================================================
 ArcHyperbolicFunctionCategory examples
@@ -516,18 +545,21 @@ ArcHyperbolicFunctionCategory(): Category == with
     atanh: $ -> $ ++ atanh(x) returns the hyperbolic arc-tangent of x.
 
 \end{chunk}
+
 \begin{chunk}{AHYP.dotabb}
 "AHYP"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=AHYP"];
 "AHYP" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{AHYP.dotfull}
 "ArcHyperbolicFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=AHYP"];
 "ArcHyperbolicFunctionCategory()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{AHYP.dotpic}
 digraph pic {
  fontsize=10;
@@ -541,6 +573,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ArcTrigonometricFunctionCategory}{ATRIG}
 \pagepic{ps/v102arctrigonometricfunctioncategory.ps}{ATRIG}{1.00}
@@ -574,6 +607,7 @@ intermediate test to check that the argument has a reciprocal values.
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ArcTrigonometricFunctionCategory.help}
 ====================================================================
 ArcTrigonometricFunctionCategory examples
@@ -638,18 +672,21 @@ ArcTrigonometricFunctionCategory(): Category == with
          asin(a::$)
 
 \end{chunk}
+
 \begin{chunk}{ATRIG.dotabb}
 "ATRIG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATRIG"];
 "ATRIG" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATRIG.dotfull}
 "ArcTrigonometricFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATRIG"];
 "ArcTrigonometricFunctionCategory()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATRIG.dotpic}
 digraph pic {
  fontsize=10;
@@ -663,9 +700,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{AttributeRegistry}{ATTREG}
 \pagepic{ps/v102attributeregistry.ps}{ATTREG}{1.00}
+
 \begin{chunk}{AttributeRegistry.input}
 )set break resume
 )sys rm -f AttributeRegistry.output
@@ -698,6 +737,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{AttributeRegistry.help}
 ====================================================================
 AttributeRegistry examples
@@ -851,18 +891,21 @@ AttributeRegistry(): Category == with
     ++ \spad{approximate} means "is an approximation to the real numbers".
 
 \end{chunk}
+
 \begin{chunk}{ATTREG.dotabb}
 "ATTREG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATTREG"];
 "ATTREG" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATTREG.dotfull}
 "AttributeRegistry()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATTREG"];
 "AttributeRegistry()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATTREG.dotpic}
 digraph pic {
  fontsize=10;
@@ -876,6 +919,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{BasicType}{BASTYPE}
 \pagepic{ps/v102basictype.ps}{BASTYPE}{1.00}
@@ -904,6 +948,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{BasicType.help}
 ====================================================================
 BasicType examples
@@ -953,18 +998,35 @@ BasicType(): Category == with
       _~_=(x:%,y:%) : Boolean == not(x=y)
 
 \end{chunk}
+
+\begin{chunk}{COQ BASTYPE}
+(* category BASTYPE *)
+(* From the Coq.Init.Logic library we know that 
+     Definition not (A:Prop) := A -> False
+   and 
+     Notation "~ x" := (not x) : type_scope. *)
+
+(*
+      ~=: (%,%) -> Boolean   
+      ~=(x:%,y:%) : Boolean == not(x=y)
+*)
+
+\end{chunk}
+
 \begin{chunk}{BASTYPE.dotabb}
 "BASTYPE"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=BASTYPE"];
 "BASTYPE" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{BASTYPE.dotfull}
 "BasicType()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=BASTYPE"];
 "BasicType()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{BASTYPE.dotpic}
 digraph pic {
  fontsize=10;
@@ -978,9 +1040,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CanonicalAttribute}{ATCANON}
 \pagepic{ps/v102canonicalattribute.eps}{ATCANON}{1.00}
+
 \begin{chunk}{CanonicalAttribute.input}
 )set break resume
 )sys rm -f CanonicalAttribute.output
@@ -1012,6 +1076,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{CanonicalAttribute.help}
 ====================================================================
 CanonicalAttribute 
@@ -1034,18 +1099,21 @@ o )show CanonicalAttribute
 CanonicalAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATCANON.dotabb}
 "ATCANON"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCANON"];
 "ATCANON" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATCANON.dotfull}
 "CanonicalAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCANON"];
 "CanonicalAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATCANON.dotpic}
 digraph pic {
  fontsize=10;
@@ -1059,9 +1127,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CanonicalClosedAttribute}{ATCANCL}
 \pagepic{ps/v102canonicalclosedattribute.eps}{ATCANCL}{1.00}
+
 \begin{chunk}{CanonicalClosedAttribute.input}
 )set break resume
 )sys rm -f CanonicalClosedAttribute.output
@@ -1092,6 +1162,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{CanonicalClosedAttribute.help}
 ====================================================================
 CanonicalClosedAttribute 
@@ -1114,18 +1185,21 @@ o )show CanonicalClosedAttribute
 CanonicalClosedAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATCANCL.dotabb}
 "ATCANCL"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCANCL"];
 "ATCANCL" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATCANCL.dotfull}
 "CanonicalClosedAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCANCL"];
 "CanonicalClosedAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATCANCL.dotpic}
 digraph pic {
  fontsize=10;
@@ -1139,9 +1213,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CanonicalUnitNormalAttribute}{ATCUNOR}
 \pagepic{ps/v102canonicalunitnormalattribute.eps}{ATCUNOR}{1.00}
+
 \begin{chunk}{CanonicalUnitNormalAttribute.input}
 )set break resume
 )sys rm -f CanonicalUnitNormalAttribute.output
@@ -1173,6 +1249,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{CanonicalUnitNormalAttribute.help}
 ====================================================================
 CanonicalUnitNormalAttribute 
@@ -1199,18 +1276,21 @@ o )show CanonicalUnitNormalAttribute
 CanonicalUnitNormalAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATCUNOR.dotabb}
 "ATCUNOR"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCUNOR"];
 "ATCUNOR" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATCUNOR.dotfull}
 "CanonicalUnitNormalAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCUNOR"];
 "CanonicalUnitNormalAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATCUNOR.dotpic}
 digraph pic {
  fontsize=10;
@@ -1224,9 +1304,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CentralAttribute}{ATCENRL}
 \pagepic{ps/v102centralattribute.eps}{ATCENRL}{1.00}
+
 \begin{chunk}{CentralAttribute.input}
 )set break resume
 )sys rm -f CentralAttribute.output
@@ -1258,6 +1340,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{CentralAttribute.help}
 ====================================================================
 CentralAttribute 
@@ -1284,18 +1367,21 @@ o )show CentralAttribute
 CentralAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATCENRL.dotabb}
 "ATCENRL"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCENRL"];
 "ATCENRL" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATCENRL.dotfull}
 "CentralAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCENRL"];
 "CentralAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATCENRL.dotpic}
 digraph pic {
  fontsize=10;
@@ -1309,6 +1395,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CoercibleTo}{KOERCE}
 \pagepic{ps/v102koerce.ps}{KOERCE}{1.00}
@@ -1337,6 +1424,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{CoercibleTo.help}
 ====================================================================
 CoercibleTo examples
@@ -1382,12 +1470,14 @@ CoercibleTo(S:Type): Category == with
       ++ coerce(a) transforms a into an element of S.
 
 \end{chunk}
+
 \begin{chunk}{KOERCE.dotabb}
 "KOERCE"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=KOERCE"];
 "KOERCE" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{KOERCE.dotfull}
 "CoercibleTo(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=KOERCE"];
@@ -1404,6 +1494,7 @@ CoercibleTo(S:Type): Category == with
   -> "CoercibleTo(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{KOERCE.dotpic}
 digraph pic {
  fontsize=10;
@@ -1417,6 +1508,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CombinatorialFunctionCategory}{CFCAT}
 \pagepic{ps/v102combinatorialfunctioncategory.ps}{CFCAT}{1.00}
@@ -1446,6 +1538,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{CombinatorialFunctionCategory.help}
 ====================================================================
 CombinatorialFunctionCategory examples
@@ -1502,18 +1595,21 @@ CombinatorialFunctionCategory(): Category == with
       ++ Note that \spad{permutation(n,m) = n!/(n-m)!}.
 
 \end{chunk}
+
 \begin{chunk}{CFCAT.dotabb}
 "CFCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=CFCAT"];
 "CFCAT" -> "CATEGORY" 
 
 \end{chunk}
+
 \begin{chunk}{CFCAT.dotfull}
 "CombinatorialFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=CFCAT"];
 "CombinatorialFunctionCategory()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{CFCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -1527,9 +1623,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CommutativeStarAttribute}{ATCS}
 \pagepic{ps/v102commutativestarattribute.eps}{ATCS}{1.00}
+
 \begin{chunk}{CommutativeStarAttribute.input}
 )set break resume
 )sys rm -f CommutativeStarAttribute.output
@@ -1561,6 +1659,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{CommutativeStarAttribute.help}
 ====================================================================
 CommutativeStarAttribute 
@@ -1585,18 +1684,21 @@ o )show CommutativeStarAttribute
 CommutativeStarAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATCS.dotabb}
 "ATCS"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCS"];
 "ATCS" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATCS.dotfull}
 "CommutativeStarAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATCS"];
 "CommutativeStarAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATCS.dotpic}
 digraph pic {
  fontsize=10;
@@ -1610,6 +1712,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ConvertibleTo}{KONVERT}
 \pagepic{ps/v102konvert.ps}{KONVERT}{1.00}
@@ -1638,6 +1741,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ConvertibleTo.help}
 ====================================================================
 ConvertibleTo examples
@@ -1684,12 +1788,14 @@ ConvertibleTo(S:Type): Category == with
       ++ convert(a) transforms a into an element of S.
 
 \end{chunk}
+
 \begin{chunk}{KONVERT.dotabb}
 "KONVERT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=KONVERT"];
 "KONVERT" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{KONVERT.dotfull}
 "ConvertibleTo(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=KONVERT"];
@@ -1757,6 +1863,7 @@ ConvertibleTo(S:Type): Category == with
     "ConvertibleTo(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{KONVERT.dotpic}
 digraph pic {
  fontsize=10;
@@ -1770,6 +1877,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ElementaryFunctionCategory}{ELEMFUN}
 \pagepic{ps/v102elementaryfunctioncategory.ps}{ELEMFUN}{1.00}
@@ -1799,6 +1907,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ElementaryFunctionCategory.help}
 ====================================================================
 ElementaryFunctionCategory examples
@@ -1851,18 +1960,32 @@ ElementaryFunctionCategory(): Category == with
      x ** y == exp(y * log x)
 
 \end{chunk}
+
+\begin{chunk}{COQ ELEMFUN}
+(* category ELEMFUN *)
+(*
+   if $ has Monoid then
+
+     **: ($, $) -> $  ++ x**y returns x to the power y.
+     x ** y == exp(y * log x)
+*)
+
+\end{chunk}
+
 \begin{chunk}{ELEMFUN.dotabb}
 "ELEMFUN"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ELEMFUN"];
 "ELEMFUN" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ELEMFUN.dotfull}
 "ElementaryFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ELEMFUN"];
 "ElementaryFunctionCategory()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ELEMFUN.dotpic}
 digraph pic {
  fontsize=10;
@@ -1876,6 +1999,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Eltable}{ELTAB}
 \pagepic{ps/v102eltab.ps}{ELTAB}{1.00}
@@ -1904,6 +2028,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Eltable.help}
 ====================================================================
 Eltable examples
@@ -1953,11 +2078,13 @@ Eltable(S:SetCategory, Index:Type): Category == with
      ++ Error: if i is not an index of u.
 
 \end{chunk}
+
 \begin{chunk}{ELTAB.dotabb}
 "ELTAB" [color=lightblue,href="bookvol10.2.pdf#nameddest=ELTAB"];
 "ELTAB" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ELTAB.dotfull}
 "Eltable(a:SetCategory,b:Type)" 
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ELTAB"];
@@ -1979,6 +2106,7 @@ Eltable(S:SetCategory, Index:Type): Category == with
    "Eltable(a:SetCategory,b:Type)" 
 
 \end{chunk}
+
 \begin{chunk}{ELTAB.dotpic}
 digraph pic {
  fontsize=10;
@@ -1992,9 +2120,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FiniteAggregateAttribute}{ATFINAG}
 \pagepic{ps/v102finiteaggregateattribute.eps}{ATFINAG}{1.00}
+
 \begin{chunk}{FiniteAggregateAttribute.input}
 )set break resume
 )sys rm -f FiniteAggregateAttribute.output
@@ -2026,6 +2156,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{FiniteAggregateAttribute.help}
 ====================================================================
 FiniteAggregateAttribute 
@@ -2046,18 +2177,21 @@ o )show FiniteAggregateAttribute
 FiniteAggregateAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATFINAG.dotabb}
 "ATFINAG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATFINAG"];
 "ATFINAG" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATFINAG.dotfull}
 "FiniteAggregateAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATFINAG"];
 "FiniteAggregateAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATFINAG.dotpic}
 digraph pic {
  fontsize=10;
@@ -2071,6 +2205,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{HyperbolicFunctionCategory}{HYPCAT}
 \pagepic{ps/v102hyperbolicfunctioncategory.ps}{HYPCAT}{1.00}
@@ -2104,6 +2239,7 @@ intermediate test to check that the argument has a reciprocal values.
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{HyperbolicFunctionCategory.help}
 ====================================================================
 HyperbolicFunctionCategory examples
@@ -2172,18 +2308,57 @@ HyperbolicFunctionCategory(): Category == with
            (e - recip(e)::$) * recip(2::$)::$
 
 \end{chunk}
+
+\begin{chunk}{COQ HYPCAT}
+(* category HYPCAT *)
+(*
+    if $ has Ring then
+
+       csch: $ -> $
+       csch x == 
+         (a := recip(sinh x)) case "failed" => error "csch: no reciprocal"
+         a::$
+
+       sech: $ -> $
+       sech x == 
+         (a := recip(cosh x)) case "failed" => error "sech: no reciprocal"
+         a::$
+
+       tanh: $ -> $
+       tanh x == sinh x * sech x
+
+       coth: $ -> $
+       coth x == cosh x * csch x
+
+       if $ has ElementaryFunctionCategory then
+
+         cosh: $ -> $
+         cosh x ==
+           e := exp x
+           (e + recip(e)::$) * recip(2::$)::$
+
+         sinh: $ -> $
+         sinh(x):$ ==
+           e := exp x
+           (e - recip(e)::$) * recip(2::$)::$
+*)
+
+\end{chunk}
+
 \begin{chunk}{HYPCAT.dotabb}
 "HYPCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=HYPCAT"];
 "HYPCAT" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{HYPCAT.dotfull}
 "HyperbolicFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=HYPCAT"];
 "HyperbolicFunctionCategory()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{HYPCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -2197,6 +2372,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{InnerEvalable}{IEVALAB}
 \pagepic{ps/v102innerevalable.ps}{IEVALAB}{1.00}
@@ -2225,6 +2401,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{InnerEvalable.help}
 ====================================================================
 InnerEvalable examples
@@ -2286,12 +2463,23 @@ InnerEvalable(A:SetCategory, B:Type): Category == with
     eval(f:$, x:A, v:B) == eval(f, [x], [v])
 
 \end{chunk}
+
+\begin{chunk}{COQ IEVALAB}
+(* category IEVALAB *)
+(*
+    eval: ($, A, B) -> $
+    eval(f:$, x:A, v:B) == eval(f, [x], [v])
+*)
+
+\end{chunk}
+
 \begin{chunk}{IEVALAB.dotabb}
 "IEVALAB"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=IEVALAB"];
 "IEVALAB" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{IEVALAB.dotfull}
 "InnerEvalable(a:SetCategory,b:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=IEVALAB"];
@@ -2323,6 +2511,7 @@ InnerEvalable(A:SetCategory, B:Type): Category == with
     "InnerEvalable(a:SetCategory,b:Type)"
 
 \end{chunk}
+
 \begin{chunk}{IEVALAB.dotpic}
 digraph pic {
  fontsize=10;
@@ -2336,9 +2525,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{JacobiIdentityAttribute}{ATJACID}
 \pagepic{ps/v102jacobiidentityattribute.eps}{ATJACID}{1.00}
+
 \begin{chunk}{JacobiIdentityAttribute.input}
 )set break resume
 )sys rm -f JacobiIdentityAttribute.output
@@ -2370,6 +2561,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{JacobiIdentityAttribute.help}
 ====================================================================
 JacobiIdentityAttribute 
@@ -2392,18 +2584,31 @@ o )show JacobiIdentityAttribute
 JacobiIdentityAttribute(): Category == with nil
 
 \end{chunk}
+
+\begin{chunk}{COQ ATJACID}
+(* category ATJACID *}
+(* 
+Axiom
+  [x,[y,z]]+[y,[z,x]]+[z,[x,y]] = 0
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ATJACID.dotabb}
 "ATJACID"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATJACID"];
 "ATJACID" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATJACID.dotfull}
 "JacobiIdentityAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATJACID"];
 "JacobiIdentityAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATJACID.dotpic}
 digraph pic {
  fontsize=10;
@@ -2417,9 +2622,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{LazyRepresentationAttribute}{ATLR}
 \pagepic{ps/v102lazyrepresentationattribute.eps}{ATLR}{1.00}
+
 \begin{chunk}{LazyRepresentationAttribute.input}
 )set break resume
 )sys rm -f LazyRepresentationAttribute.output
@@ -2451,6 +2658,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{LazyRepresentationAttribute.help}
 ====================================================================
 LazyRepresentationAttribute 
@@ -2471,18 +2679,21 @@ o )show LazyRepresentationAttribute
 LazyRepresentationAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATLR.dotabb}
 "ATLR"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATLR"];
 "ATLR" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATLR.dotfull}
 "LazyRepresentationAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATLR"];
 "LazyRepresentationAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATLR.dotpic}
 digraph pic {
  fontsize=10;
@@ -2496,9 +2707,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{LeftUnitaryAttribute}{ATLUNIT}
 \pagepic{ps/v102leftunitaryattribute.eps}{ATLUNIT}{1.00}
+
 \begin{chunk}{LeftUnitaryAttribute.input}
 )set break resume
 )sys rm -f LeftUnitaryAttribute.output
@@ -2530,6 +2743,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{LeftUnitaryAttribute.help}
 ====================================================================
 LeftUnitaryAttribute 
@@ -2550,18 +2764,29 @@ o )show LeftUnitaryAttribute
 LeftUnitaryAttribute(): Category == with nil
 
 \end{chunk}
+
+\begin{chunk}{COQ ATLUNIT}
+(* category ATLUNIT *)
+(*
+   LeftUnitary is true if 1 * x = x for all x.
+
+*)
+\end{chunk}
+
 \begin{chunk}{ATLUNIT.dotabb}
 "ATLUNIT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATLUNIT"];
 "ATLUNIT" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATLUNIT.dotfull}
 "LeftUnitaryAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATLUNIT"];
 "LeftUnitaryAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATLUNIT.dotpic}
 digraph pic {
  fontsize=10;
@@ -2575,6 +2800,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ModularAlgebraicGcdOperations}{MAGCDOC}
 \pagepic{ps/v102modularalgebraicgcdoperations.ps}{MAGCDOC}{1.00}
@@ -2609,6 +2835,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ModularAlgebraicGcdOperations.help}
 ====================================================================
 ModularAlgebraicGcdOperations 
@@ -2699,18 +2926,21 @@ ModularAlgebraicGcdOperations(MPT : Type, MD : Type) : Category ==
           ++ by packExps.
 
 \end{chunk}
+
 \begin{chunk}{MAGCDOC.dotabb}
 "MAGCDOC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MAGCDOC"];
 "MAGCDOC" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{MAGCDOC.dotfull}
 "ModularAlgebraicGcdOperations()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MAGCDOC"];
 "ModularAlgebraicGcdOperations(a:Type,b:Type)" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{MAGCDOC.dotpic}
 digraph pic {
  fontsize=10;
@@ -2724,9 +2954,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{MultiplicativeValuationAttribute}{ATMULVA}
 \pagepic{ps/v102multiplicativevaluationattribute.eps}{ATMULVA}{1.00}
+
 \begin{chunk}{MultiplicativeValuationAttribute.input}
 )set break resume
 )sys rm -f MultiplicativeValuationAttribute.output
@@ -2758,6 +2990,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{MultiplicativeValuationAttribute.help}
 ====================================================================
 MultiplicativeValuationAttribute 
@@ -2780,18 +3013,30 @@ o )show MultiplicativeValuationAttribute
 MultiplicativeValuationAttribute(): Category == with nil
 
 \end{chunk}
+
+\begin{chunk}{COQ ATMULVA}
+(* category ATMULVA *)
+(*
+Axiom
+   euclideanSize(a*b)=euclideanSize(a)*euclideanSize(b)
+
+*)
+\end{chunk}
+
 \begin{chunk}{ATMULVA.dotabb}
 "ATMULVA"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATMULVA"];
 "ATMULVA" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATMULVA.dotfull}
 "MultiplicativeValuationAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATMULVA"];
 "MultiplicativeValuationAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATMULVA.dotpic}
 digraph pic {
  fontsize=10;
@@ -2805,9 +3050,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{NotherianAttribute}{ATNOTHR}
 \pagepic{ps/v102notherianattribute.eps}{ATNOTHR}{1.00}
+
 \begin{chunk}{NotherianAttribute.input}
 )set break resume
 )sys rm -f NotherianAttribute.output
@@ -2839,6 +3086,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{NotherianAttribute.help}
 ====================================================================
 NotherianAttribute 
@@ -2859,18 +3107,21 @@ o )show NotherianAttribute
 NotherianAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATNOTHR.dotabb}
 "ATNOTHR"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNOTHR"];
 "ATNOTHR" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATNOTHR.dotfull}
 "NotherianAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNOTHR"];
 "NotherianAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATNOTHR.dotpic}
 digraph pic {
  fontsize=10;
@@ -2884,9 +3135,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{NoZeroDivisorsAttribute}{ATNZDIV}
 \pagepic{ps/v102nozerodivisorsattribute.eps}{ATNZDIV}{1.00}
+
 \begin{chunk}{NoZeroDivisorsAttribute.input}
 )set break resume
 )sys rm -f NoZeroDivisorsAttribute.output
@@ -2918,6 +3171,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{NoZeroDivisorsAttribute.help}
 ====================================================================
 NoZeroDivisorsAttribute 
@@ -2940,18 +3194,31 @@ o )show NoZeroDivisorsAttribute
 NoZeroDivisorsAttribute(): Category == with nil
 
 \end{chunk}
+
+\begin{chunk}{COQ ATNZDIV}
+(* category ATNZDIV *)
+(*
+Axiom
+  The class of all semirings such that x * y ~= 0 implies
+  both x and y are non-zero.
+
+*)
+\end{chunk}
+
 \begin{chunk}{ATNZDIV.dotabb}
 "ATNZDIV"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNZDIV"];
 "ATNZDIV" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATNZDIV.dotfull}
 "NoZeroDivisorsAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNZDIV"];
 "NoZeroDivisorsAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATNZDIV.dotpic}
 digraph pic {
  fontsize=10;
@@ -2965,9 +3232,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{NullSquareAttribute}{ATNULSQ}
 \pagepic{ps/v102nullsquareattribute.eps}{ATNULSQ}{1.00}
+
 \begin{chunk}{NullSquareAttribute.input}
 )set break resume
 )sys rm -f NullSquareAttribute.output
@@ -2999,6 +3268,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{NullSquareAttribute.help}
 ====================================================================
 NullSquareAttribute 
@@ -3019,18 +3289,30 @@ o )show NullSquareAttribute
 NullSquareAttribute(): Category == with nil
 
 \end{chunk}
+
+\begin{chunk}{COQ ATNULSQ}
+(* category ATNULSQ *)
+(*
+Axiom
+  NullSquare means that [x,x] = 0 holds. See LieAlgebra.
+
+*)
+\end{chunk}
+
 \begin{chunk}{ATNULSQ.dotabb}
 "ATNULSQ"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNULSQ"];
 "ATNULSQ" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATNULSQ.dotfull}
 "NullSquareAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATNULSQ"];
 "NullSquareAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATNULSQ.dotpic}
 digraph pic {
  fontsize=10;
@@ -3044,6 +3326,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OpenMath}{OM}
 \pagepic{ps/v102openmath.ps}{OM}{1.00}
@@ -3074,6 +3357,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OpenMath.help}
 ====================================================================
 OpenMath examples
@@ -3129,18 +3413,21 @@ OpenMath(): Category == with
   ++ OMwrite(dev, u, false) writes the object as an OpenMath fragment.
 
 \end{chunk}
+
 \begin{chunk}{OM.dotabb}
 "OM"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OM"];
 "OM" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{OM.dotfull}
 "OpenMath()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OM"];
 "OpenMath()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{OM.dotpic}
 digraph pic {
  fontsize=10;
@@ -3154,9 +3441,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PartiallyOrderedSetAttribute}{ATPOSET}
 \pagepic{ps/v102partiallyorderedsetattribute.eps}{ATPOSET}{1.00}
+
 \begin{chunk}{PartiallyOrderedSetAttribute.input}
 )set break resume
 )sys rm -f PartiallyOrderedSetAttribute.output
@@ -3188,6 +3477,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{PartiallyOrderedSetAttribute.help}
 ====================================================================
 PartiallyOrderedSetAttribute 
@@ -3210,18 +3500,31 @@ o )show PartiallyOrderedSetAttribute
 PartiallyOrderedSetAttribute(): Category == with nil
 
 \end{chunk}
+
+\begin{chunk}{COQ ATPOSET}
+(* category ATPOSET *)
+(*
+Axiom
+  PartiallyOrderedSet is true if a set with < is transitive,
+  but not(a <b or a = b). It does not imply b < a
+
+*)
+\end{chunk}
+
 \begin{chunk}{ATPOSET.dotabb}
 "ATPOSET"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATPOSET"];
 "ATPOSET" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATPOSET.dotfull}
 "PartiallyOrderedSetAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATPOSET"];
 "PartiallyOrderedSetAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATPOSET.dotpic}
 digraph pic {
  fontsize=10;
@@ -3235,6 +3538,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PartialTranscendentalFunctions}{PTRANFN}
 \pagepic{ps/v102partialtranscendentalfunctions.ps}{PTRANFN}{1.00}
@@ -3276,6 +3580,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PartialTranscendentalFunctions.help}
 ====================================================================
 PartialTranscendentalFunctions examples
@@ -3443,12 +3748,14 @@ PartialTranscendentalFunctions(K): Category == Definition where
       ++ acschIfCan(z) returns acsch(z) if possible, and "failed" otherwise.
 
 \end{chunk}
+
 \begin{chunk}{PTRANFN.dotabb}
 "PTRANFN"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PTRANFN"];
 "PTRANFN" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{PTRANFN.dotfull}
 "PartialTranscendentalFunctions(TranscendentalFunctionCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PTRANFN"];
@@ -3456,6 +3763,7 @@ PartialTranscendentalFunctions(K): Category == Definition where
    "Category()"
 
 \end{chunk}
+
 \begin{chunk}{PTRANFN.dotpic}
 digraph pic {
  fontsize=10;
@@ -3472,6 +3780,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Patternable}{PATAB}
 \pagepic{ps/v102patternable.ps}{PATAB}{1.00}
@@ -3501,6 +3810,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Patternable.help}
 ====================================================================
 Patternable examples
@@ -3556,12 +3866,14 @@ Patternable(R:Type): Category == with
            ConvertibleTo Pattern Float
 
 \end{chunk}
+
 \begin{chunk}{PATAB.dotabb}
 "PATAB"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PATAB"];
 "PATAB" -> "CATEGORY" 
 
 \end{chunk}
+
 \begin{chunk}{PATAB.dotfull}
 "Patternable(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PATAB"];
@@ -3580,6 +3892,7 @@ Patternable(R:Type): Category == with
 "Patternable(CommutativeRing)" -> "Patternable(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{PATAB.dotpic}
 digraph pic {
  fontsize=10;
@@ -3593,6 +3906,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PrimitiveFunctionCategory}{PRIMCAT}
 \pagepic{ps/v102primitivefunctioncategory.ps}{PRIMCAT}{1.00}
@@ -3622,6 +3936,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PrimitiveFunctionCategory.help}
 ====================================================================
 PrimitiveFunctionCategory examples
@@ -3665,18 +3980,21 @@ PrimitiveFunctionCategory(): Category == with
       ++ of f dx for x between \spad{a} and b.
 
 \end{chunk}
+
 \begin{chunk}{PRIMCAT.dotabb}
 "PRIMCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PRIMCAT"];
 "PRIMCAT" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{PRIMCAT.dotfull}
 "PrimitiveFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PRIMCAT"];
 "PrimitiveFunctionCategory()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{PRIMCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -3690,6 +4008,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{RadicalCategory}{RADCAT}
 \pagepic{ps/v102radicalcategory.ps}{RADCAT}{1.00}
@@ -3719,6 +4038,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{RadicalCategory.help}
 ====================================================================
 RadicalCategory examples
@@ -3776,18 +4096,34 @@ RadicalCategory(): Category == with
   nthRoot(x, n) == x ** inv(n::Fraction(Integer))
 
 \end{chunk}
+
+\begin{chunk}{COQ RADCAT}
+(* category RADCAT *)
+(*
+  sqrt : % -> %
+  sqrt x == x ** inv(2::Fraction(Integer))
+
+  nthRoot: (%, Integer) -> %
+  nthRoot(x, n) == x ** inv(n::Fraction(Integer))
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{RADCAT.dotabb}
 "RADCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RADCAT"];
 "RADCAT" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{RADCAT.dotfull}
 "RadicalCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RADCAT"];
 "RadicalCategory()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{RADCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -3801,6 +4137,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{RetractableTo}{RETRACT}
 \pagepic{ps/v102retractableto.ps}{RETRACT}{1.00}
@@ -3830,6 +4167,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{RetractableTo.help}
 ====================================================================
 RetractableTo examples
@@ -3908,12 +4246,26 @@ RetractableTo(S: Type): Category == with
       u
 
 \end{chunk}
+
+\begin{chunk}{COQ RETRACT}
+(* category RETRACT *)
+(*
+    retract: % -> S
+    retract(s) ==
+      (u:=retractIfCan s) case "failed" => error "not retractable"
+      u
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{RETRACT.dotabb}
 "RETRACT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RETRACT"];
 "RETRACT" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{RETRACT.dotfull}
 "RetractableTo(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RETRACT"];
@@ -3973,6 +4325,7 @@ RetractableTo(S: Type): Category == with
 "RetractableTo(OrderedFreeMonoid(OrderedSet))" -> "RetractableTo(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{RETRACT.dotpic}
 digraph pic {
  fontsize=10;
@@ -3986,9 +4339,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{RightUnitaryAttribute}{ATRUNIT}
 \pagepic{ps/v102rightunitaryattribute.eps}{ATRUNIT}{1.00}
+
 \begin{chunk}{RightUnitaryAttribute.input}
 )set break resume
 )sys rm -f RightUnitaryAttribute.output
@@ -4019,6 +4374,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{RightUnitaryAttribute.help}
 ====================================================================
 RightUnitaryAttribute 
@@ -4039,18 +4395,31 @@ o )show RightUnitaryAttribute
 RightUnitaryAttribute(): Category == with nil
 
 \end{chunk}
+
+\begin{chunk}{COQ ATRUNIT}
+(* category ATRUNIT *)
+(*
+Axiom
+   RightUnitary is true if x * 1 = x for all x.
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ATRUNIT.dotabb}
 "ATRUNIT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATRUNIT"];
 "ATRUNIT" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATRUNIT.dotfull}
 "RightUnitaryAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATRUNIT"];
 "RightUnitaryAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATRUNIT.dotpic}
 digraph pic {
  fontsize=10;
@@ -4064,9 +4433,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ShallowlyMutableAttribute}{ATSHMUT}
 \pagepic{ps/v102shallowlymutableattribute.eps}{ATSHMUT}{1.00}
+
 \begin{chunk}{ShallowlyMutableAttribute.input}
 )set break resume
 )sys rm -f ShallowlyMutableAttribute.output
@@ -4098,6 +4469,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{ShallowlyMutableAttribute.help}
 ====================================================================
 ShallowlyMutableAttribute 
@@ -4122,18 +4494,21 @@ o )show ShallowlyMutableAttribute
 ShallowlyMutableAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATSHMUT.dotabb}
 "ATSHMUT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATSHMUT"];
 "ATSHMUT" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATSHMUT.dotfull}
 "ShallowlyMutableAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATSHMUT"];
 "ShallowlyMutableAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATSHMUT.dotpic}
 digraph pic {
  fontsize=10;
@@ -4147,6 +4522,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{SpecialFunctionCategory}{SPFCAT}
 \pagepic{ps/v102specialfunctioncategory.ps}{SPFCAT}{1.00}
@@ -4180,6 +4556,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{SpecialFunctionCategory.help}
 ====================================================================
 SpecialFunctionCategory examples
@@ -4263,18 +4640,21 @@ SpecialFunctionCategory(): Category == with
         ++ airyBi(x) is the Airy function \spad{Bi(x)}.
 
 \end{chunk}
+
 \begin{chunk}{SPFCAT.dotabb}
 "SPFCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SPFCAT"];
 "SPFCAT" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{SPFCAT.dotfull}
 "SpecialFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SPFCAT"];
 "SpecialFunctionCategory()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{SPFCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -4288,6 +4668,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{TrigonometricFunctionCategory}{TRIGCAT}
 \pagepic{ps/v102trigonometricfunctioncategory.ps}{TRIGCAT}{1.00}
@@ -4321,6 +4702,7 @@ intermediate test to check that the argument has a reciprocal values.
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{TrigonometricFunctionCategory.help}
 ====================================================================
 TrigonometricFunctionCategory examples
@@ -4387,18 +4769,45 @@ TrigonometricFunctionCategory(): Category == with
        cot x == cos x * csc x
 
 \end{chunk}
+
+\begin{chunk}{COQ TRIGCAT}
+(* category TRIGCAT *)
+(*
+    if $ has Ring then
+
+       csc: $ -> $        ++ csc(x) returns the cosecant of x.
+       csc x == 
+         (a := recip(sin x)) case "failed" => error "csc: no reciprocal"
+         a::$
+
+       sec: $ -> $        ++ sec(x) returns the secant of x.
+       sec x == 
+         (a := recip(cos x)) case "failed" => error "sec: no reciprocal"
+         a::$
+
+       tan: $ -> $        ++ tan(x) returns the tangent of x.
+       tan x == sin x * sec x
+
+       cot: $ -> $        ++ cot(x) returns the cotangent of x.
+       cot x == cos x * csc x
+
+*)
+\end{chunk}
+
 \begin{chunk}{TRIGCAT.dotabb}
 "TRIGCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=TRIGCAT"];
 "TRIGCAT" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{TRIGCAT.dotfull}
 "TrigonometricFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=TRIGCAT"];
 "TrigonometricFunctionCategory()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{TRIGCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -4412,6 +4821,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Type}{TYPE}
 \pagepic{ps/v102type.ps}{TYPE}{1.00}
@@ -4448,7 +4858,6 @@ digraph pic {
 )lisp (bye)
 \end{chunk}
 
-
 \begin{chunk}{Type.help}
 ====================================================================
 Type examples
@@ -4484,16 +4893,19 @@ o )show Type
 Type(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{TYPE.dotabb}
 "TYPE" [color=lightblue,href="bookvol10.2.pdf#nameddest=TYPE"];
 "TYPE" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{TYPE.dotfull}
 "Type()" [color=lightblue,href="bookvol10.2.pdf#nameddest=TYPE"];
 "Type()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{TYPE.dotpic}
 digraph pic {
  fontsize=10;
@@ -4507,9 +4919,11 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{UnitsKnownAttribute}{ATUNIKN}
 \pagepic{ps/v102unitsknownattribute.eps}{ATUNIKN}{1.00}
+
 \begin{chunk}{UnitsKnownAttribute.input}
 )set break resume
 )sys rm -f UnitsKnownAttribute.output
@@ -4541,6 +4955,7 @@ digraph pic {
 )lisp (bye)
 
 \end{chunk}
+
 \begin{chunk}{UnitsKnownAttribute.help}
 ====================================================================
 UnitsKnownAttribute 
@@ -4565,18 +4980,21 @@ o )show UnitsKnownAttribute
 UnitsKnownAttribute(): Category == with nil
 
 \end{chunk}
+
 \begin{chunk}{ATUNIKN.dotabb}
 "ATUNIKN"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATUNIKN"];
 "ATUNIKN" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{ATUNIKN.dotfull}
 "UnitsKnownAttribute()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ATUNIKN"];
 "UnitsKnownAttribute()" -> "Category"
 
 \end{chunk}
+
 \begin{chunk}{ATUNIKN.dotpic}
 digraph pic {
  fontsize=10;
@@ -4591,6 +5009,7 @@ digraph pic {
 
 \end{chunk}
 \chapter{Category Layer 2}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Aggregate}{AGG}
 \pagepic{ps/v102agg.ps}{AGG}{1.00}
@@ -4625,6 +5044,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Aggregate.help}
 ====================================================================
 Aggregate examples
@@ -4745,17 +5165,46 @@ Aggregate: Category == Type with
     size?(a,n) == #a = n
 
 \end{chunk}
+
+\begin{chunk}{COQ AGG}
+(* category AGG *)
+(*
+
+  eq?: (%,%) -> Boolean
+  eq?(a,b) == EQ(a,b)$Lisp
+
+  sample: constant -> %
+  sample() == empty()
+
+  if % has finiteAggregate then
+
+    empty?: % -> Boolean
+    empty? a   == #a = 0
+
+    less?: (%,NonNegativeInteger) -> Boolean
+    less?(a,n) == #a < n
+
+    more?: (%,NonNegativeInteger) -> Boolean
+    more?(a,n) == #a > n
+
+    size?: (%,NonNegativeInteger) -> Boolean
+    size?(a,n) == #a = n
+
+*)
+
 \begin{chunk}{AGG.dotabb}
 "AGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=AGG"];
 "AGG" -> "TYPE"
 
 \end{chunk}
+
 \begin{chunk}{AGG.dotfull}
 "Aggregate()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=AGG"];
 "Aggregate()" -> "Type()"
 
 \end{chunk}
+
 \begin{chunk}{AGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -4772,6 +5221,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CombinatorialOpsCategory}{COMBOPC}
 \pagepic{ps/v102combinatorialopscategory.ps}{COMBOPC}{1.00}
@@ -4805,6 +5255,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{CombinatorialOpsCategory.help}
 ====================================================================
 CombinatorialOpsCategory examples
@@ -4879,18 +5330,21 @@ CombinatorialOpsCategory(): Category ==
       ++ formal product;
 
 \end{chunk}
+
 \begin{chunk}{COMBOPC.dotabb}
 "COMBOPC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=COMBOPC"];
 "COMBOPC" -> "CFCAT"
 
 \end{chunk}
+
 \begin{chunk}{COMBOPC.dotfull}
 "CombinatorialOpsCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=COMBOPC"];
 "CombinatorialOpsCategory()" -> "CombinatorialFunctionCategory()"
 
 \end{chunk}
+
 \begin{chunk}{COMBOPC.dotpic}
 digraph pic {
  fontsize=10;
@@ -4907,6 +5361,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Comparable}{COMPAR}
 \pagepic{ps/v102compar.eps}{COMPAR}{1.00}
@@ -4937,6 +5392,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Comparable.help}
 ====================================================================
 Comparable examples
@@ -4968,17 +5424,20 @@ Comparable(): Category == SetCategory with
       ++ smaller?(x, y) is a strict total ordering on the elements of the set.
 
 \end{chunk}
+
 \begin{chunk}{COMPAR.dotabb}
 "COMPAR" [color=lightblue,href="bookvol10.2.pdf#nameddest=COMPAR"];
 "COMPAR" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{COMPAR.dotfull}
 "Comparable()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=COMPAR"];
 "Comparable()" -> "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{COMPAR.dotpic}
 digraph pic {
  fontsize=10;
@@ -5005,6 +5464,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{EltableAggregate}{ELTAGG}
 \pagepic{ps/v102eltableaggregate.ps}{ELTAGG}{0.75}
@@ -5036,6 +5496,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{EltableAggregate.help}
 ====================================================================
 EltableAggregate examples
@@ -5131,23 +5592,45 @@ EltableAggregate(Dom:SetCategory, Im:Type): Category ==
            ++ the domain of \axiom{u}.
            ++ If such a check is required use the function \axiom{setelt}.
  add
+
+  qelt(a, x) == elt(a, x)
+
+  if % has shallowlyMutable then
+
+    qsetelt_!(a, x, y) == (a.x := y)
+
+\end{chunk}
+
+\begin{chunk}{COQ ELTAGG}
+(* category ELTAGG *)
+(*
+
+  qelt: (%, Dom) -> Im
   qelt(a, x) == elt(a, x)
+
   if % has shallowlyMutable then
+
+    qsetelt_!: (%, Dom, Im) -> Im
     qsetelt_!(a, x, y) == (a.x := y)
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{ELTAGG.dotabb}
 "ELTAGG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ELTAGG"];
 "ELTAGG" -> "ELTAB"
 
 \end{chunk}
+
 \begin{chunk}{ELTAGG.dotfull}
 "EltableAggregate(a:SetCategory,b:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ELTAGG"];
 "EltableAggregate(a:SetCategory,b:Type)" -> "Eltable(a:SetCategory,b:Type)"
 
 \end{chunk}
+
 \begin{chunk}{ELTAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -5164,6 +5647,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Evalable}{EVALAB}
 \pagepic{ps/v102evalable.ps}{EVALAB}{1.00}
@@ -5193,6 +5677,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Evalable.help}
 ====================================================================
 Evalable examples
@@ -5252,12 +5737,27 @@ Evalable(R:SetCategory): Category == InnerEvalable(R,R) with
     eval(f:$, xs:List R,vs:List R) == eval(f,[x=v for x in xs for v in vs])
 
 \end{chunk}
+
+\begin{chunk}{COQ EVALAB}
+(* category EVALAB *)
+(*
+    eval: ($, Equation R) -> $
+    eval(f:$, eq:Equation R) == eval(f, [eq])
+
+    eval: ($, List Equation R) -> $
+    eval(f:$, xs:List R,vs:List R) == eval(f,[x=v for x in xs for v in vs])
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{EVALAB.dotabb}
 "EVALAB"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=EVALAB"];
 "EVALAB" -> "IEVALAB"
 
 \end{chunk}
+
 \begin{chunk}{EVALAB.dotfull}
 "Evalable(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=EVALAB"];
@@ -5278,6 +5778,7 @@ Evalable(R:SetCategory): Category == InnerEvalable(R,R) with
   -> "Evalable(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{EVALAB.dotpic}
 digraph pic {
  fontsize=10;
@@ -5298,6 +5799,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FortranProgramCategory}{FORTCAT}
 \pagepic{ps/v102fortranprogramcategory.ps}{FORTCAT}{1.00}
@@ -5326,6 +5828,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FortranProgramCategory.help}
 ====================================================================
 FortranProgramCategory examples
@@ -5384,6 +5887,7 @@ FortranProgramCategory():Category == Join(Type,CoercibleTo OutputForm) with
     ++ subprogram.
 
 \end{chunk}
+
 \begin{chunk}{FORTCAT.dotabb}
 "FORTCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FORTCAT"];
@@ -5391,6 +5895,7 @@ FortranProgramCategory():Category == Join(Type,CoercibleTo OutputForm) with
 "FORTCAT" -> "TYPE"
 
 \end{chunk}
+
 \begin{chunk}{FORTCAT.dotfull}
 "FortranProgramCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FORTCAT"];
@@ -5421,6 +5926,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FullyRetractableTo}{FRETRCT}
 \pagepic{ps/v102fullyretractableto.ps}{FRETRCT}{1.00}
@@ -5550,6 +6056,44 @@ FullyRetractableTo(S: Type): Category == RetractableTo(S) with
           retractIfCan(u::S)
 
 \end{chunk}
+
+\begin{chunk}{COQ FRETRCT}
+(* category FRETRCT *)
+(*
+    if not(S is Integer) then
+
+      if (S has RetractableTo Integer) then    -- induction
+
+        coerce : Integer -> % 
+        coerce(n:Integer):%  == n::S::%
+
+        retract : % -> Integer 
+        retract(r:%):Integer == retract(retract(r)@S)
+ 
+        retractIfCan : % -> Union(Integer,"failed") 
+        retractIfCan(r:%):Union(Integer, "failed") ==
+          (u:= retractIfCan(r)@Union(S,"failed")) case "failed"=> "failed"
+          retractIfCan(u::S)
+ 
+    if not(S is Fraction Integer) then
+
+      if (S has RetractableTo Fraction Integer) then   -- induction
+
+        coerce : Fraction Integer -> % 
+        coerce(n:Fraction Integer):%  == n::S::%
+
+        retract : % -> Fraction Integer 
+        retract(r:%):Fraction(Integer) == retract(retract(r)@S)
+ 
+        retractIfCan : % -> Union(Fraction Integer,"failed") 
+        retractIfCan(r:%):Union(Fraction Integer, "failed") ==
+          (u:=retractIfCan(r)@Union(S,"failed")) case "failed"=>"failed"
+          retractIfCan(u::S)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FRETRCT.dotabb}
 "FRETRCT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FRETRCT"];
@@ -5578,6 +6122,7 @@ FullyRetractableTo(S: Type): Category == RetractableTo(S) with
 "FullyRetractableTo(Fraction(Integer))" -> "FullyRetractableTo(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{FRETRCT.dotpic}
 digraph pic {
  fontsize=10;
@@ -5594,6 +6139,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FullyPatternMatchable}{FPATMAB}
 \pagepic{ps/v102fullypatternmatchable.ps}{FPATMAB}{1.00}
@@ -5712,12 +6258,14 @@ FullyPatternMatchable(R:Type): Category == Type with
   if R has PatternMatchable Float   then PatternMatchable Float
 
 \end{chunk}
+
 \begin{chunk}{FPATMAB.dotabb}
 "FPATMAB"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FPATMAB"];
 "FPATMAB" -> "TYPE"
 
 \end{chunk}
+
 \begin{chunk}{FPATMAB.dotfull}
 "FullyPatternMatchable(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FPATMAB"];
@@ -5739,6 +6287,7 @@ FullyPatternMatchable(R:Type): Category == Type with
   "FullyPatternMatchable(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{FPATMAB.dotpic}
 digraph pic {
  fontsize=10;
@@ -5755,6 +6304,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Logic}{LOGIC}
 \pagepic{ps/v102logic.ps}{LOGIC}{1.00}
@@ -5845,6 +6395,17 @@ Logic: Category == BasicType with
     _\_/(x: %,y: %) == _~( _/_\(_~(x), _~(y)))
 
 \end{chunk}
+
+\begin{chunk}{COQ LOGIC}
+(* category LOGIC *)
+(*
+    _\_/: (%, %) -> %
+    _\_/(x: %,y: %) == _~( _/_\(_~(x), _~(y)))
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{LOGIC.dotabb}
 "LOGIC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LOGIC"];
@@ -5873,6 +6434,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PlottablePlaneCurveCategory}{PPCURVE}
 \pagepic{ps/v102plottableplanecurvecategory.ps}{PPCURVE}{1.00}
@@ -5969,18 +6531,21 @@ PlottablePlaneCurveCategory(): Category == Definition where
       ++ on the curve c.
 
 \end{chunk}
+
 \begin{chunk}{PPCURVE.dotabb}
 "PPCURVE"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PPCURVE"];
 "PPCURVE" -> "KOERCE"
 
 \end{chunk}
+
 \begin{chunk}{PPCURVE.dotfull}
 "PlottablePlaneCurveCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PPCURVE"];
 "PlottablePlaneCurveCategory()" -> "CoercibleTo(OutputForm)"
 
 \end{chunk}
+
 \begin{chunk}{PPCURVE.dotpic}
 digraph pic {
  fontsize=10;
@@ -6000,6 +6565,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PlottableSpaceCurveCategory}{PSCURVE}
 \pagepic{ps/v102plottablespacecurvecategory.ps}{PSCURVE}{1.00}
@@ -6106,18 +6672,21 @@ PlottableSpaceCurveCategory(): Category == Definition where
       ++ on the curve c.
 
 \end{chunk}
+
 \begin{chunk}{PSCURVE.dotabb}
 "PSCURVE"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PSCURVE"];
 "PSCURVE" -> "KOERCE"
 
 \end{chunk}
+
 \begin{chunk}{PSCURVE.dotfull}
 "PlottableSpaceCurveCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PSCURVE"];
 "PlottableSpaceCurveCategory()" -> "CoercibleTo(OutputForm)"
 
 \end{chunk}
+
 \begin{chunk}{PSCURVE.dotpic}
 digraph pic {
  fontsize=10;
@@ -6137,6 +6706,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{RealConstant}{REAL}
 \pagepic{ps/v102realconstant.ps}{REAL}{1.00}
@@ -6208,12 +6778,14 @@ RealConstant(): Category ==
   Join(ConvertibleTo DoubleFloat, ConvertibleTo Float)
 
 \end{chunk}
+
 \begin{chunk}{REAL.dotabb}
 "REAL"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=REAL"];
 "REAL" -> "KONVERT"
 
 \end{chunk}
+
 \begin{chunk}{REAL.dotfull}
 "RealConstant()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=REAL"];
@@ -6221,6 +6793,7 @@ RealConstant(): Category ==
 "RealConstant()" -> "ConvertibleTo(Float)"
 
 \end{chunk}
+
 \begin{chunk}{REAL.dotpic}
 digraph pic {
  fontsize=10;
@@ -6244,6 +6817,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{SegmentCategory}{SEGCAT}
 \pagepic{ps/v102segmentcategory.ps}{SEGCAT}{1.00}
@@ -6362,12 +6936,14 @@ SegmentCategory(S:Type): Category == Type with
         ++ convert(i) creates the segment \spad{i..i}.
 
 \end{chunk}
+
 \begin{chunk}{SEGCAT.dotabb}
 "SEGCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SEGCAT"];
 "SEGCAT" -> "TYPE"
 
 \end{chunk}
+
 \begin{chunk}{SEGCAT.dotfull}
 "SegmentCategory(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SEGCAT"];
@@ -6378,6 +6954,7 @@ SegmentCategory(S:Type): Category == Type with
 "SegmentCategory(OrderedRing)" -> "SegmentCategory(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{SEGCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -6394,6 +6971,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{SetCategory}{SETCAT}
 \pagepic{ps/v102setcategory.ps}{SETCAT}{1.00}
@@ -6514,6 +7092,21 @@ SetCategory(): Category == Join(BasicType,CoercibleTo OutputForm) with
     latex(s : %): String       == "\mbox{\bf Unimplemented}"
 
 \end{chunk}
+
+\begin{chunk}{COQ SETCAT}
+(* category SETCAT *)
+(*
+
+    hash: % -> SingleInteger  
+    hash(s : %): SingleInteger == SXHASH(s)$Lisp
+
+    latex: % -> String       
+    latex(s : %): String == "\mbox{\bf Unimplemented}"
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{SETCAT.dotabb}
 "SETCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SETCAT"];
@@ -6521,6 +7114,7 @@ SetCategory(): Category == Join(BasicType,CoercibleTo OutputForm) with
 "SETCAT" -> "KOERCE"
 
 \end{chunk}
+
 \begin{chunk}{SETCAT.dotfull}
 "SetCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SETCAT"];
@@ -6528,6 +7122,7 @@ SetCategory(): Category == Join(BasicType,CoercibleTo OutputForm) with
 "SetCategory()" -> "CoercibleTo(OutputForm)"
 
 \end{chunk}
+
 \begin{chunk}{SETCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -6552,6 +7147,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{TranscendentalFunctionCategory}{TRANFUN}
 \pagepic{ps/v102transcendentalfunctioncategory.ps}{TRANFUN}{0.75}
@@ -6739,6 +7335,54 @@ TranscendentalFunctionCategory(): Category ==
        atanh x == (log(1+x)-log(1-x))/2::$
 
 \end{chunk}
+
+\begin{chunk}{COQ TRANFUN}
+(* category TRANFUN *)
+(*
+     if $ has Ring then
+
+       pi : () -> $        ++ pi() returns the constant pi.
+       pi() == 2*asin(1)
+
+       acsch : % -> %                       
+       acsch x == 
+         (a := recip x) case "failed" => error "acsch: no reciprocal"
+         asinh(a::$)
+
+       asech : % -> %                       
+       asech x == 
+         (a := recip x) case "failed" => error "asech: no reciprocal"
+         acosh(a::$)
+
+       acoth : % -> %                       
+       acoth x == 
+         (a := recip x) case "failed" => error "acoth: no reciprocal"
+         atanh(a::$)
+
+     if $ has Field and $ has sqrt: $ -> $ then
+
+       asin : % -> %
+       asin x == atan(x/sqrt(1-x**2))
+
+       acos : % -> %
+       acos x == pi()/2::$ - asin x
+
+       acot : % -> %
+       acot x == pi()/2::$ - atan x
+
+       asinh : % -> %                       
+       asinh x == log(x + sqrt(x**2 + 1))
+
+       acosh : % -> %                       
+       acosh x == 2*log(sqrt((x+1)/2::$) + sqrt((x-1)/2::$))
+
+       atanh : % -> %                       
+       atanh x == (log(1+x)-log(1-x))/2::$
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{TRANFUN.dotabb}
 "TRANFUN"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=TRANFUN"];
@@ -6903,10 +7547,26 @@ AbelianSemiGroup(): Category == SetCategory with
         ++ integer n. This is equivalent to adding x to itself n times.
     add
       import RepeatedDoubling(%)
+
+      if not (% has Ring) then
+        n:PositiveInteger * x:% == double(n,x)
+
+\end{chunk}
+
+\begin{chunk}{COQ ABELSG}
+(* category ABELSG *)
+(*
+      import RepeatedDoubling(%)
+
       if not (% has Ring) then
+
+        "*": (PositiveInteger,%) -> %
         n:PositiveInteger * x:% == double(n,x)
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{ABELSG.dotabb}
 "ABELSG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ABELSG"];
@@ -6914,6 +7574,7 @@ AbelianSemiGroup(): Category == SetCategory with
 "ABELSG" -> "REPDB"
 
 \end{chunk}
+
 \begin{chunk}{ABELSG.dotfull}
 "AbelianSemiGroup()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ABELSG"];
@@ -6921,6 +7582,7 @@ AbelianSemiGroup(): Category == SetCategory with
 "AbelianSemiGroup()" -> "RepeatedDoubling(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{ABELSG.dotpic}
 digraph pic {
  fontsize=10;
@@ -6957,6 +7619,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{BlowUpMethodCategory}{BLMETCT}
 \pagepic{ps/v102blowupmethodcategory.ps}{BLMETCT}{0.75}
@@ -6991,6 +7654,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{BlowUpMethodCategory.help}
 ====================================================================
 BlowUpMethodCategory examples
@@ -7071,18 +7735,21 @@ BlowUpMethodCategory:Category ==  SetCategory with
 
   type: % -> Union("left","center","right","vertical","horizontal")
 \end{chunk}
+
 \begin{chunk}{BLMETCT.dotabb}
 "BLMETCT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=BLMETCT"];
 "BLMETCT" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{BLMETCT.dotfull}
 "BlowUpMethodCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=BLMETCT"];
 "BlowUpMethodCategory()" -> "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{BLMETCT.dotpic}
 digraph pic {
  fontsize=10;
@@ -7110,6 +7777,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{DesingTreeCategory}{DSTRCAT}
 \pagepic{ps/v102desingtreecategory.eps}{DSTRCAT}{0.75}
@@ -7313,18 +7981,21 @@ DesingTreeCategory(S: SetCategory):Category == RecursiveAggregate(S) with
     ++ tree(l) creates a chain tree from the list l
 
 \end{chunk}
+
 \begin{chunk}{DSTRCAT.dotabb}
 "DSTRCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=DSTRCAT"];
 "EVALAB" [color="#4488FF",href="bookvol10.2.pdf#nameddest=EVALAB"]
 "DSTRCAT" -> "EVALAB"
 
 \end{chunk}
+
 \begin{chunk}{DSTRCAT.dotfull}
 "DesingTreeCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DSTRCAT"];
 "DesingTreeCategory()" -> "Evalable()"
 
 \end{chunk}
+
 \begin{chunk}{DSTRCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -7349,6 +8020,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FortranFunctionCategory}{FORTFN}
 \pagepic{ps/v102fortranfunctioncategory.ps}{FORTFN}{1.00}
@@ -7389,6 +8061,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FortranFunctionCategory.help}
 ====================================================================
 FortranFunctionCategory examples
@@ -7505,18 +8178,21 @@ FortranFunctionCategory():Category == FortranProgramCategory with
   --     of FortranExpression.
 
 \end{chunk}
+
 \begin{chunk}{FORTFN.dotabb}
 "FORTFN"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FORTFN"];
 "FORTFN" -> "FORTCAT"
 
 \end{chunk}
+
 \begin{chunk}{FORTFN.dotfull}
 "FortranFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FORTFN"];
 "FortranFunctionCategory()" -> "FortranProgramCategory()"
 
 \end{chunk}
+
 \begin{chunk}{FORTFN.dotpic}
 digraph pic {
  fontsize=10;
@@ -7543,6 +8219,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FortranMatrixCategory}{FMC}
 \pagepic{ps/v102fortranmatrixcategory.ps}{FMC}{1.00}
@@ -7574,6 +8251,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FortranMatrixCategory.help}
 ====================================================================
 FortranMatrixCategory examples
@@ -7642,18 +8320,21 @@ FortranMatrixCategory():Category == FortranProgramCategory with
       ++ making the declarations in the \spadtype{SymbolTable} component.
 
 \end{chunk}
+
 \begin{chunk}{FMC.dotabb}
 "FMC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FMC"];
 "FMC" -> "FORTCAT"
 
 \end{chunk}
+
 \begin{chunk}{FMC.dotfull}
 "FortranMatrixCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FMC"];
 "FortranMatrixCategory()" -> "FortranProgramCategory()"
 
 \end{chunk}
+
 \begin{chunk}{FMC.dotpic}
 digraph pic {
  fontsize=10;
@@ -7680,6 +8361,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FortranMatrixFunctionCategory}{FMFUN}
 \pagepic{ps/v102fortranmatrixfunctioncategory.ps}{FMFUN}{1.00}
@@ -7722,6 +8404,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FortranMatrixFunctionCategory.help}
 ====================================================================
 FortranMatrixFunctionCategory examples
@@ -7838,18 +8521,21 @@ FortranMatrixFunctionCategory():Category == FortranProgramCategory with
     --     of Matrix FortranExpression.
 
 \end{chunk}
+
 \begin{chunk}{FMFUN.dotabb}
 "FMFUN"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FMFUN"];
 "FMFUN" -> "FORTCAT"
 
 \end{chunk}
+
 \begin{chunk}{FMFUN.dotfull}
 "FortranMatrixFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FMFUN"];
 "FortranMatrixFunctionCategory()" -> "FortranProgramCategory()"
 
 \end{chunk}
+
 \begin{chunk}{FMFUN.dotpic}
 digraph pic {
  fontsize=10;
@@ -7876,6 +8562,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FortranVectorCategory}{FVC}
 \pagepic{ps/v102fortranvectorcategory.ps}{FVC}{1.00}
@@ -7907,6 +8594,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FortranVectorCategory.help}
 ====================================================================
 FortranVectorCategory examples
@@ -7974,18 +8662,21 @@ FortranVectorCategory():Category == FortranProgramCategory with
       ++ making the declarations in the \spadtype{SymbolTable} component.
 
 \end{chunk}
+
 \begin{chunk}{FVC.dotabb}
 "FVC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FVC"];
 "FVC" -> "FORTCAT"
 
 \end{chunk}
+
 \begin{chunk}{FVC.dotfull}
 "FortranVectorCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FVC"];
 "FortranVectorCategory()" -> "FortranProgramCategory()"
 
 \end{chunk}
+
 \begin{chunk}{FVC.dotpic}
 digraph pic {
  fontsize=10;
@@ -8012,6 +8703,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FortranVectorFunctionCategory}{FVFUN}
 \pagepic{ps/v102fortranvectorfunctioncategory.ps}{FVFUN}{1.00}
@@ -8054,6 +8746,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FortranVectorFunctionCategory.help}
 ====================================================================
 FortranVectorFunctionCategory examples
@@ -8170,18 +8863,21 @@ FortranVectorFunctionCategory():Category == FortranProgramCategory with
     --     of Vector FortranExpression.
 
 \end{chunk}
+
 \begin{chunk}{FVFUN.dotabb}
 "FVFUN"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FVFUN"];
 "FVFUN" -> "FORTCAT"
 
 \end{chunk}
+
 \begin{chunk}{FVFUN.dotfull}
 "FortranVectorFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FVFUN"];
 "FortranVectorFunctionCategory()" -> "FortranProgramCategory()"
 
 \end{chunk}
+
 \begin{chunk}{FVFUN.dotpic}
 digraph pic {
  fontsize=10;
@@ -8208,6 +8904,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FullyEvalableOver}{FEVALAB}
 \pagepic{ps/v102fullyevalableover.ps}{FEVALAB}{0.75}
@@ -8243,6 +8940,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FullyEvalableOver.help}
 ====================================================================
 FullyEvalableOver examples
@@ -8319,6 +9017,28 @@ FullyEvalableOver(R:SetCategory): Category == with
       eval(x:$, ls:List Symbol, lv:List R) == map(y +-> eval(y, ls, lv), x)
 
 \end{chunk}
+
+\begin{chunk}{COQ FEVALAB}
+(* category FEVALAB *)
+(*
+    if R has Eltable(R, R) then
+
+      elt(x:$, r:R) == map(y +-> y(r), x)
+
+    if R has Evalable(R) then
+
+      eval : (%,List(Equation(R))) -> %
+      eval(x:$, l:List Equation R) == map(y +-> eval(y, l), x)
+
+    if R has InnerEvalable(Symbol, R) then
+
+      eval : (%,List(Symbol),List(R)) -> %
+      eval(x:$, ls:List Symbol, lv:List R) == map(y +-> eval(y, ls, lv), x)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FEVALAB.dotabb}
 "FEVALAB"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FEVALAB"];
@@ -8328,6 +9048,7 @@ FullyEvalableOver(R:SetCategory): Category == with
 "FEVALAB" -> "CATEGORY"
 
 \end{chunk}
+
 \begin{chunk}{FEVALAB.dotfull}
 "FullyEvalableOver(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FEVALAB"];
@@ -8346,6 +9067,7 @@ FullyEvalableOver(R:SetCategory): Category == with
   "FullyEvalableOver(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{FEVALAB.dotpic}
 digraph pic {
  fontsize=10;
@@ -8380,6 +9102,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FileCategory}{FILECAT}
 \pagepic{ps/v102filecategory.ps}{FILECAT}{1.00}
@@ -8414,6 +9137,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FileCategory.help}
 ====================================================================
 FileCategory examples
@@ -8522,18 +9246,21 @@ FileCategory(Name, S): Category == FCdefinition where
           ++ flush(f) makes sure that buffered data is written out
  
 \end{chunk}
+
 \begin{chunk}{FILECAT.dotabb}
 "FILECAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FILECAT"];
 "FILECAT" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{FILECAT.dotfull}
 "FileCategory(a:SetCategory,b:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FILECAT"];
 "FileCategory(a:SetCategory,b:SetCategory)" -> "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{FILECAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -8561,6 +9288,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Finite}{FINITE}
 \pagepic{ps/v102finite.ps}{FINITE}{1.00}
@@ -8593,6 +9321,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Finite.help}
 ====================================================================
 Finite examples
@@ -8691,18 +9420,39 @@ Finite(): Category == SetCategory with
   enumerate() == [index(i::PositiveInteger) for i in 1..size()]
 
 \end{chunk}
+
+\begin{chunk}{COQ FINITE}
+(* category FINITE *)
+(*
+   
+Axioms:
+  lookup(index(n)) = n
+  index(lookup(s)) = s
+
+  random: () -> %
+  random() == index((1+random(size()$%))::PositiveInteger)
+
+  enumerate: () -> List %
+  enumerate() == [index(i::PositiveInteger) for i in 1..size()]
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FINITE.dotabb}
 "FINITE"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FINITE"];
 "FINITE" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{FINITE.dotfull}
 "Finite()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FINITE"];
 "Finite()" -> "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{FINITE.dotpic}
 digraph pic {
  fontsize=10;
@@ -8730,6 +9480,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FileNameCategory}{FNCAT}
 \pagepic{ps/v102filenamecategory.ps}{FNCAT}{0.70}
@@ -8765,6 +9516,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FileNameCategory.help}
 ====================================================================
 FileNameCategory examples
@@ -8864,18 +9616,21 @@ FileNameCategory(): Category == SetCategory with
      ++ directory.
 
 \end{chunk}
+
 \begin{chunk}{FNCAT.dotabb}
 "FNCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FNCAT"];
 "FNCAT" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{FNCAT.dotfull}
 "FileNameCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FNCAT"];
 "FileNameCategory()" -> "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{FNCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -8904,6 +9659,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{GradedModule}{GRMOD}
 \pagepic{ps/v102gradedmodule.ps}{GRMOD}{1.00}
@@ -8937,6 +9693,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{GradedModule.help}
 ====================================================================
 GradedModule examples
@@ -9051,18 +9808,32 @@ GradedModule(R: CommutativeRing, E: AbelianMonoid): Category ==
     (x: %) - (y: %) == x+(-y)
 
 \end{chunk}
+
+\begin{chunk}{COQ GRMOD}
+(* category GRMOD *)
+(*
+
+    -: (%, %) -> %
+    (x: %) - (y: %) == x+(-y)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{GRMOD.dotabb}
 "GRMOD"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=GRMOD"];
 "GRMOD" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{GRMOD.dotfull}
 "GradedModule(a:CommutativeRing,b:AbelianMonoid)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=GRMOD"];
 "GradedModule(a:CommutativeRing,b:AbelianMonoid)" -> "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{GRMOD.dotpic}
 digraph pic {
  fontsize=10;
@@ -9090,6 +9861,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{LeftOreRing}{LORER}
 \pagepic{ps/v102leftorering.eps}{LORER}{1.00}
@@ -9161,18 +9933,21 @@ LeftOreRing : Category == EntireRing with
      ++ and llcm_res = coeff1*c1 = coeff2*c2
 
 \end{chunk}
+
 \begin{chunk}{LORER.dotabb}
 "LORER"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LORER"];
 "LORER" -> "BMODULE"
 
 \end{chunk}
+
 \begin{chunk}{LORER.dotfull}
 "LeftOreRing()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LORER"];
 "LeftOreRing()" -> "EntireRing()"
 
 \end{chunk}
+
 \begin{chunk}{LORER.dotpic}
 digraph pic {
  fontsize=10;
@@ -9186,6 +9961,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{HomogeneousAggregate}{HOAGG}
 \pagepic{ps/v102homogeneousaggregate.ps}{HOAGG}{1.00}
@@ -9237,6 +10013,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{HomogeneousAggregate.help}
 ====================================================================
 HomogeneousAggregate examples
@@ -9436,6 +10213,53 @@ HomogeneousAggregate(S:Type): Category == Aggregate with
             commaSeparate [a::OutputForm for a in parts x]$List(OutputForm)
 
 \end{chunk}
+
+\begin{chunk}{COQ HOAGG}
+(* category HOAGG *)
+(*
+   if S has Evalable S then
+
+     eval : (%,List(Equation(S))) -> %
+     eval(u:%,l:List Equation S):% == map(x +-> eval(x,l),u)
+
+   if % has finiteAggregate then
+
+     #? : % -> NonNegativeInteger
+     #c == # parts c
+
+     any?: (S->Boolean,%) -> Boolean
+     any?(f, c)  == _or/[f x for x in parts c]
+
+     every?: (S->Boolean,%) -> Boolean
+     every?(f, c) == _and/[f x for x in parts c]
+
+     count: (S->Boolean,%) -> NonNegativeInteger
+     count(f:S -> Boolean, c:%) == _+/[1 for x in parts c | f x]
+
+     members: % -> List S
+     members x == parts x
+
+     if S has SetCategory then
+
+       count: (S,%) -> NonNegativeInteger
+       count(s:S, x:%) == count(y +-> s = y, x)
+
+       member?: (S,%) -> Boolean
+       member?(e, c)   == any?(x +-> e = x,c)
+
+       ?=? : (%,%) -> Boolean
+       x = y ==
+          size?(x, #y) and _and/[a = b for a in parts x for b in parts y]
+
+       coerce : % -> OutputForm
+       coerce(x:%):OutputForm ==
+         bracket
+            commaSeparate [a::OutputForm for a in parts x]$List(OutputForm)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{HOAGG.dotabb}
 "HOAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=HOAGG"];
 "HOAGG" -> "AGG"
@@ -9452,6 +10276,7 @@ HomogeneousAggregate(S:Type): Category == Aggregate with
   -> "HomogeneousAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{HOAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -9489,6 +10314,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{IndexedDirectProductCategory}{IDPC}
 \pagepic{ps/v102liouvillianfunctioncategory.ps}{IDPC}{1.00}
@@ -9521,6 +10347,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{IndexedDirectProductCategory.help}
 ====================================================================
 IndexedDirectProductCategory examples
@@ -9600,12 +10427,14 @@ IndexedDirectProductCategory(A:SetCategory,S:OrderedSet): Category ==
        ++ Error: if z has no support.
 
 \end{chunk}
+
 \begin{chunk}{IDPC.dotabb}
 "IDPC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=IDPC"];
 "IDPC" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{IDPC.dotfull}
 "IndexedDirectProductCategory(a:SetCategory,b:OrderedSet)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=IDPC"];
@@ -9613,6 +10442,7 @@ IndexedDirectProductCategory(A:SetCategory,S:OrderedSet): Category ==
    "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{IDPC.dotpic}
 digraph pic {
  fontsize=10;
@@ -9641,6 +10471,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{LiouvillianFunctionCategory}{LFCAT}
 \pagepic{ps/v102liouvillianfunctioncategory.ps}{LFCAT}{0.60}
@@ -9688,6 +10519,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{LiouvillianFunctionCategory.help}
 ====================================================================
 LiouvillianFunctionCategory examples
@@ -9840,6 +10672,7 @@ LiouvillianFunctionCategory(): Category ==
       ++ C(x) = integrate(cos(t^2),t=0..x)
 
 \end{chunk}
+
 \begin{chunk}{LFCAT.dotabb}
 "LFCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LFCAT"];
@@ -9847,6 +10680,7 @@ LiouvillianFunctionCategory(): Category ==
 "LFCAT" -> "TRANFUN"
 
 \end{chunk}
+
 \begin{chunk}{LFCAT.dotfull}
 "LiouvillianFunctionCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LFCAT"];
@@ -9854,6 +10688,7 @@ LiouvillianFunctionCategory(): Category ==
 "LiouvillianFunctionCategory()" -> "TranscendentalFunctionCategory()"
 
 \end{chunk}
+
 \begin{chunk}{LFCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -9898,6 +10733,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Monad}{MONAD}
 \pagepic{ps/v102monad.ps}{MONAD}{0.70}
@@ -9931,6 +10767,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Monad.help}
 ====================================================================
 Monad examples
@@ -10033,12 +10870,41 @@ Monad(): Category == SetCategory with
         res
 
 \end{chunk}
+
+\begin{chunk}{COQ MONAD}
+(* category MONAD *)
+(*
+
+      import RepeatedSquaring(%)
+
+      "**": (%,PositiveInteger) -> %
+      x:% ** n:PositiveInteger == expt(x,n)
+
+      rightPower: (%,PositiveInteger) -> %
+      rightPower(a,n) ==
+        (n = 1) => a
+        res := a
+        for i in 1..(n-1) repeat res := res * a
+        res
+
+      leftPower: (%,PositiveInteger) -> %
+      leftPower(a,n) ==
+        (n = 1) => a
+        res := a
+        for i in 1..(n-1) repeat res := a * res
+        res
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{MONAD.dotabb}
 "MONAD"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MONAD"];
 "MONAD" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{MONAD.dotfull}
 "Monad()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MONAD"];
@@ -10046,6 +10912,7 @@ Monad(): Category == SetCategory with
 "Monad()" -> "RepeatedSquaring(Monad)"
 
 \end{chunk}
+
 \begin{chunk}{MONAD.dotpic}
 digraph pic {
  fontsize=10;
@@ -10082,6 +10949,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{NumericalIntegrationCategory}{NUMINT}
 \pagepic{ps/v102numericalintegrationcategory.ps}{NUMINT}{1.00}
@@ -10116,6 +10984,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{NumericalIntegrationCategory.help}
 ====================================================================
 NumericalIntegrationCategory examples
@@ -10282,6 +11151,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{NumericalOptimizationCategory}{OPTCAT}
 \pagepic{ps/v102numericaloptimizationcategory.ps}{OPTCAT}{1.00}
@@ -10316,6 +11186,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{NumericalOptimizationCategory.help}
 ====================================================================
 NumericalOptimizationCategory examples
@@ -10437,18 +11308,21 @@ NumericalOptimizationCategory(): Category == Exports where
     ++ function given the strategy or method returned by \axiomFun{measure}.
 
 \end{chunk}
+
 \begin{chunk}{OPTCAT.dotabb}
 "OPTCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OPTCAT"];
 "OPTCAT" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{OPTCAT.dotfull}
 "NumericalOptimizationCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OPTCAT"];
 "NumericalOptimizationCategory()" -> "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{OPTCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -10476,6 +11350,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OrdinaryDifferentialEquationsSolverCategory}{ODECAT}
 \pagepic{ps/v102ordinarydifferentialequationssolvercategory.ps}{ODECAT}{1.00}
@@ -10508,6 +11383,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OrdinaryDifferentialEquationsSolverCategory.help}
 ====================================================================
 OrdinaryDifferentialEquationsSolverCategory examples
@@ -10608,6 +11484,7 @@ OrdinaryDifferentialEquationsSolverCategory(): Category == Exports where
     ++ function given the strategy or method returned by \axiomFun{measure}.
 
 \end{chunk}
+
 \begin{chunk}{ODECAT.dotabb}
 "ODECAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ODECAT"];
@@ -10648,6 +11525,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OrderedSet}{ORDSET}
 \pagepic{ps/v102orderedset.ps}{ORDSET}{1.00}
@@ -10681,6 +11559,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OrderedSet.help}
 ====================================================================
 OrderedSet examples
@@ -10796,18 +11675,51 @@ OrderedSet(): Category == SetCategory with
     ((x: %) <= (y: %)) : Boolean == not (y < x)
 
 \end{chunk}
+
+\begin{chunk}{COQ ORDSET}
+(* category ORDSET *)
+(*
+    x,y: %
+
+  -- These really ought to become some sort of macro
+
+    max: (%,%) -> %
+    max(x,y) ==
+      x > y => x
+      y
+
+    min: (%,%) -> %
+    min(x,y) ==
+      x > y => y
+      x
+
+    ">": (%, %) -> Boolean
+    ((x: %) >  (y: %)) : Boolean == y < x
+
+    ">=": (%, %) -> Boolean
+    ((x: %) >= (y: %)) : Boolean == not (x < y)
+
+    "<=": (%, %) -> Boolean
+    ((x: %) <= (y: %)) : Boolean == not (y < x)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ORDSET.dotabb}
 "ORDSET" 
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDSET"];
 "ORDSET" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{ORDSET.dotfull}
 "OrderedSet()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDSET"];
 "OrderedSet()" -> "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{ORDSET.dotpic}
 digraph pic {
  fontsize=10;
@@ -10834,6 +11746,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PartialDifferentialEquationsSolverCategory}{PDECAT}
 \pagepic{ps/v102partialdifferentialequationssolvercategory.ps}{PDECAT}{1.00}
@@ -10866,6 +11779,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PartialDifferentialEquationsSolverCategory.help}
 ====================================================================
 PartialDifferentialEquationsSolverCategory examples
@@ -11035,6 +11949,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PatternMatchable}{PATMAB}
 \pagepic{ps/v102patternmatchable.ps}{PATMAB}{1.00}
@@ -11130,12 +12045,14 @@ PatternMatchable(S:SetCategory): Category == SetCategory with
     ++ which is an empty list of matches.
 
 \end{chunk}
+
 \begin{chunk}{PATMAB.dotabb}
 "PATMAB"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PATMAB"];
 "PATMAB" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{PATMAB.dotfull}
 "PatternMatchable(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PATMAB"];
@@ -11150,6 +12067,7 @@ PatternMatchable(S:SetCategory): Category == SetCategory with
 "PatternMatchable(Float)" -> "PatternMatchable(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{PATMAB.dotpic}
 digraph pic {
  fontsize=10;
@@ -11178,6 +12096,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{RealRootCharacterizationCategory}{RRCC}
 \pagepic{ps/v102realrootcharacterizationcategory.ps}{RRCC}{0.60}
@@ -11215,6 +12134,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{RealRootCharacterizationCategory.help}
 ====================================================================
 RealRootCharacterizationCategory examples
@@ -11360,12 +12280,54 @@ RealRootCharacterizationCategory(TheField, ThePols ) : Category == PUB where
           d.coef.2
 
 \end{chunk}
+
+\begin{chunk}{COQ RRCC}
+(* category RRCC *)
+(*
+
+        zero? : ( ThePols, $ ) -> Boolean
+        zero?(toTest, rootChar) == 
+          sign(toTest, rootChar) = 0
+                
+        negative?: ( ThePols, $ ) -> Boolean
+        negative?(toTest, rootChar) == 
+          sign(toTest, rootChar) < 0              
+        
+        positive?: ( ThePols, $ ) -> Boolean
+        positive?(toTest, rootChar) == 
+          sign(toTest, rootChar) > 0
+
+        rootOf: ( ThePols, N ) -> Union($,"failed")
+        rootOf(pol,n) ==
+          liste:List($):= allRootsOf(pol)
+          # liste > n => "failed"
+          liste.n
+
+        recip: ( ThePols, $ ) -> Union(ThePols,"failed") 
+        recip(toInv,rootChar) ==
+          degree(toInv) = 0 => 
+            res := recip(leadingCoefficient(toInv))
+            if (res case "failed") then "failed" else (res::TheField::ThePols)
+          defPol := definingPolynomial(rootChar)
+          d := principalIdeal([defPol,toInv])
+          zero?(d.generator,rootChar) => "failed"
+          if (degree(d.generator) ^= 0 )
+          then
+            defPol := (defPol exquo (d.generator))::ThePols
+            d := principalIdeal([defPol,toInv])
+          d.coef.2
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{RRCC.dotabb}
 "RRCC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RRCC"];
 "RRCC" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{RRCC.dotfull}
 "RealRootCharacterizationCategory(a:Join(OrderedRing,Field),b:UnivariatePolynomialCategory(a))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RRCC"];
@@ -11373,6 +12335,7 @@ RealRootCharacterizationCategory(TheField, ThePols ) : Category == PUB where
   -> "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{RRCC.dotpic}
 digraph pic {
  fontsize=10;
@@ -11402,6 +12365,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{SegmentExpansionCategory}{SEGXCAT}
 \pagepic{ps/v102segmentexpansioncategory.ps}{SEGXCAT}{0.75}
@@ -11435,6 +12399,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{SegmentExpansionCategory.help}
 ====================================================================
 SegmentExpansionCategory examples
@@ -11467,7 +12432,6 @@ o )show SegmentExpansionCategory
 \cross{SEGXCAT}{?..?} &&&&
 \end{tabular}
 
-
 {\bf Attributes exported:}
 \begin{itemize}
 \item {\bf nil}
@@ -11518,12 +12482,14 @@ SegmentExpansionCategory(S: OrderedRing, L: StreamAggregate(S)): Category ==
         ++ \spad{[f(l), f(l+k), ..., f(lN)]}, where \spad{lN <= h < lN+k}.
 
 \end{chunk}
+
 \begin{chunk}{SEGXCAT.dotabb}
 "SEGXCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SEGXCAT"];
 "SEGXCAT" -> "SEGCAT"
 
 \end{chunk}
+
 \begin{chunk}{SEGXCAT.dotfull}
 "SegmentExpansionCategory(a:OrderedRing,b:StreamAggregate(OrderedRing))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SEGXCAT"];
@@ -11531,6 +12497,7 @@ SegmentExpansionCategory(S: OrderedRing, L: StreamAggregate(S)): Category ==
    -> "SegmentCategory(OrderedRing)"
 
 \end{chunk}
+
 \begin{chunk}{SEGXCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -11556,6 +12523,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{SemiGroup}{SGROUP}
 \pagepic{ps/v102semigroup.ps}{SGROUP}{0.75}
@@ -11594,6 +12562,7 @@ operator ``*''. A Semigroup $G(S,*)$ is:
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{SemiGroup.help}
 ====================================================================
 SemiGroup examples
@@ -11683,12 +12652,29 @@ SemiGroup(): Category == SetCategory with
     _^(x:%, n:PositiveInteger):% == x ** n
 
 \end{chunk}
+
+\begin{chunk}{COQ SGROUP}
+(* category SGROUP *)
+(*
+    import RepeatedSquaring(%)
+
+    "**": (%,PositiveInteger) -> %   
+    x:% ** n:PositiveInteger == expt(x,n)
+
+    "^": (%,PositiveInteger) -> %    
+    _^(x:%, n:PositiveInteger):% == x ** n
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{SGROUP.dotabb}
 "SGROUP"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SGROUP"];
 "SGROUP" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{SGROUP.dotfull}
 "SemiGroup()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SGROUP"];
@@ -11696,6 +12682,7 @@ SemiGroup(): Category == SetCategory with
 "SemiGroup()" -> "RepeatedSquaring(a:SemiGroup)"
 
 \end{chunk}
+
 \begin{chunk}{SGROUP.dotpic}
 digraph pic {
  fontsize=10;
@@ -11732,6 +12719,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{SetCategoryWithDegree}{SETCATD}
 \pagepic{ps/v102setcategorywithdegree.ps}{SETCATD}{0.75}
@@ -11762,6 +12750,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{SetCategoryWithDegree.help}
 ====================================================================
 SetCategoryWithDegree examples
@@ -11817,18 +12806,21 @@ SetCategoryWithDegree:Category == SetCategory with
     degree: % -> PositiveInteger
 
 \end{chunk}
+
 \begin{chunk}{SETCATD.dotabb}
 "SETCATD"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SETCATD"];
 "SETCATD" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{SETCATD.dotfull}
 "SetCategoryWithDegree()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SETCATD"];
 "SetCategoryWithDegree()" -> "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{SETCATD.dotpic}
 digraph pic {
  fontsize=10;
@@ -11858,6 +12850,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{SExpressionCategory}{SEXCAT}
 \pagepic{ps/v102sexpressioncategory.ps}{SEXCAT}{0.60}
@@ -11901,6 +12894,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{SExpressionCategory.help}
 ====================================================================
 SExpressionCategory examples
@@ -12063,12 +13057,14 @@ SExpressionCategory(Str, Sym, Int, Flt, Expr): Category == Decl where
           ++ elt((a1,...,an), [i1,...,im]) returns \spad{(a_i1,...,a_im)}.
 
 \end{chunk}
+
 \begin{chunk}{SEXCAT.dotabb}
 "SEXCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SEXCAT"];
 "SEXCAT" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{SEXCAT.dotfull}
 "SExpressionCategory(a:SetCategory,b:SetCategory,c:SetCategory,d:SetCategory,e:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SEXCAT"];
@@ -12076,6 +13072,7 @@ SExpressionCategory(Str, Sym, Int, Flt, Expr): Category == Decl where
    "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{SEXCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -12105,6 +13102,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{StepThrough}{STEP}
 \pagepic{ps/v102stepthrough.ps}{STEP}{1.00}
@@ -12136,6 +13134,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{StepThrough.help}
 ====================================================================
 StepThrough examples
@@ -12253,6 +13252,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ThreeSpaceCategory}{SPACEC}
 \pagepic{ps/v102threespacecategory.ps}{SPACEC}{1.00}
@@ -12316,6 +13316,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ThreeSpaceCategory.help}
 ====================================================================
 ThreeSpaceCategory examples
@@ -12777,18 +13778,21 @@ ThreeSpaceCategory(R:Ring): Exports == Implementation where
       ++ coerce(s) returns the \spadtype{ThreeSpace} s to Output format.
 
 \end{chunk}
+
 \begin{chunk}{SPACEC.dotabb}
 "SPACEC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SPACEC"];
 "SPACEC" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{SPACEC.dotfull}
 "ThreeSpaceCategory(a:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SPACEC"];
 "ThreeSpaceCategory(a:Ring)" -> "SetCategory()"
 
 \end{chunk}
+
 \begin{chunk}{SPACEC.dotpic}
 digraph pic {
  fontsize=10;
@@ -12816,6 +13820,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 4}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{AbelianMonoid}{ABELMON}
@@ -12850,6 +13855,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{AbelianMonoid.help}
 ====================================================================
 AbelianMonoid examples
@@ -12935,15 +13941,46 @@ AbelianMonoid(): Category == AbelianSemiGroup with
         ++ n * x is left-multiplication by a non negative integer
     add
       import RepeatedDoubling(%)
+
       zero? x == x = 0
+
       n:PositiveInteger * x:% == (n::NonNegativeInteger) * x
+
+      sample() == 0
+
+      if not (% has Ring) then
+
+        n:NonNegativeInteger * x:% ==
+          zero? n => 0
+          double(n pretend PositiveInteger,x)
+
+\end{chunk}
+
+\begin{chunk}{COQ ABELMON}
+(* category ABELMON *)
+(*
+      import RepeatedDoubling(%)
+
+      zero?: % -> Boolean
+      zero? x == x = 0
+
+      ?*? : (PositiveInteger,%) -> %
+      n:PositiveInteger * x:% == (n::NonNegativeInteger) * x
+
+      sample: constant -> %
       sample() == 0
+
       if not (% has Ring) then
+
+        "*": (NonNegativeInteger,%) -> %
         n:NonNegativeInteger * x:% ==
           zero? n => 0
           double(n pretend PositiveInteger,x)
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{ABELMON.dotabb}
 "ABELMON"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ABELMON"];
@@ -12995,6 +14032,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{AffineSpaceCategory}{AFSPCAT}
 \pagepic{ps/v102affinespacecategory.ps}{AFSPCAT}{0.75}
@@ -13036,6 +14074,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{AffineSpaceCategory.help}
 ====================================================================
 AffineSpaceCategory examples
@@ -13181,18 +14220,21 @@ AffineSpaceCategory(K:Field):Category == Implementation where
      ++ of origin that represent an infinitly close point
 
 \end{chunk}
+
 \begin{chunk}{AFSPCAT.dotabb}
 "AFSPCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=AFSPCAT"];
 "AFSPCAT" -> "SETCATD"
 
 \end{chunk}
+
 \begin{chunk}{AFSPCAT.dotfull}
 "AffineSpaceCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=AFSPCAT"];
 "AffineSpaceCategory()" -> "SetCategoryWithDegree()"
 
 \end{chunk}
+
 \begin{chunk}{AFSPCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -13227,6 +14269,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{BagAggregate}{BGAGG}
 \pagepic{ps/v102bagaggregate.ps}{BGAGG}{1.00}
@@ -13280,6 +14323,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{BagAggregate.help}
 ====================================================================
 BagAggregate examples
@@ -13423,11 +14467,26 @@ BagAggregate(S:Type): Category == HomogeneousAggregate S with
      x
 
 \end{chunk}
+
+\begin{chunk}{COQ BGAGG}
+(* category BGAGG *)
+(*
+
+   bag: List S -> %
+   bag(l) ==
+     x:=empty()
+     for s in l repeat x:=insert_!(s,x)
+     x
+*)
+
+\end{chunk}
+
 \begin{chunk}{BGAGG.dotabb}
 "BGAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=BGAGG"];
 "BGAGG" -> "HOAGG"
 
 \end{chunk}
+
 \begin{chunk}{BGAGG.dotfull}
 "BagAggregate(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=BGAGG"];
@@ -13438,6 +14497,7 @@ BagAggregate(S:Type): Category == HomogeneousAggregate S with
 "BagAggregate(a:SetCategory)" -> "BagAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{BGAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -13460,6 +14520,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CachableSet}{CACHSET}
 \pagepic{ps/v102cachableset.ps}{CACHSET}{1.00}
@@ -13494,6 +14555,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{CachableSet.help}
 ====================================================================
 CachableSet examples
@@ -13565,18 +14627,21 @@ CachableSet: Category == OrderedSet with
     ++ setPosition(x, n) associates the integer n to x.
 
 \end{chunk}
+
 \begin{chunk}{CACHSET.dotabb}
 "CACHSET"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=CACHSET"];
 "CACHSET" -> "ORDSET"
 
 \end{chunk}
+
 \begin{chunk}{CACHSET.dotfull}
 "CachableSet()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=CACHSET"];
 "CachableSet()" -> "OrderedSet()"
 
 \end{chunk}
+
 \begin{chunk}{CACHSET.dotpic}
 digraph pic {
  fontsize=10;
@@ -13606,6 +14671,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Collection}{CLAGG}
 \pagepic{ps/v102collection.ps}{CLAGG}{1.00}
@@ -13666,6 +14732,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Collection.help}
 ====================================================================
 Collection examples
@@ -13885,11 +14952,61 @@ Collection(S:Type): Category == HomogeneousAggregate(S) with
        removeDuplicates(x) == construct removeDuplicates parts x
 
 \end{chunk}
+
+\begin{chunk}{COQ CLAGG}
+(* category CLAGG *)
+(*
+   if % has finiteAggregate then
+
+     #? : % -> NonNegativeInteger
+     #c == # parts c
+
+     count : ((S -> Boolean),%) -> NonNegativeInteger
+     count(f:S -> Boolean, c:%) == _+/[1 for x in parts c | f x]
+
+     any? : ((S -> Boolean),%) -> Boolean
+     any?(f, c) == _or/[f x for x in parts c]
+
+     every? : ((S -> Boolean),%) -> Boolean
+     every?(f, c) == _and/[f x for x in parts c]
+
+     find: (S->Boolean, %) -> Union(S, "failed")
+     find(f:S -> Boolean, c:%) == find(f, parts c)
+
+     reduce: ((S,S)->S,%) -> S
+     reduce(f:(S,S)->S, x:%) == reduce(f, parts x)
+
+     reduce: ((S,S)->S,%,S) -> S
+     reduce(f:(S,S)->S, x:%, s:S) == reduce(f, parts x, s)
+
+     remove: (S->Boolean,%) -> %
+     remove(f:S->Boolean, x:%) ==
+       construct remove(f, parts x)
+
+     select: (S->Boolean,%) -> %
+     select(f:S->Boolean, x:%) ==
+       construct select(f, parts x)
+
+     if S has SetCategory then
+
+       remove: (S,%) -> %
+       remove(s:S, x:%) == remove(y +-> y = s, x)
+
+       reduce: ((S,S)->S,%,S,S) -> S
+       reduce(f:(S,S)->S, x:%, s1:S, s2:S) == reduce(f, parts x, s1, s2)
+
+       removeDuplicates: % -> %
+       removeDuplicates(x) == construct removeDuplicates parts x
+*)
+
+\end{chunk}
+
 \begin{chunk}{CLAGG.dotabb}
 "CLAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=CLAGG"];
 "CLAGG" -> "HOAGG"
 
 \end{chunk}
+
 \begin{chunk}{CLAGG.dotfull}
 "Collection(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=CLAGG"];
@@ -13905,6 +15022,7 @@ Collection(S:Type): Category == HomogeneousAggregate(S) with
   -> "Collection(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{CLAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -13934,6 +15052,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{DifferentialVariableCategory}{DVARCAT}
 \pagepic{ps/v102differentialvariablecategory.ps}{DVARCAT}{1.00}
@@ -13973,6 +15092,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{DifferentialVariableCategory.help}
 ====================================================================
 DifferentialVariableCategory examples
@@ -14194,6 +15314,52 @@ DifferentialVariableCategory(S:OrderedSet): Category ==
       --  the default weight is just the order
 
 \end{chunk}
+
+\begin{chunk}{COQ DVARCAT}
+(* category DVARCAT *)
+(*
+    import NumberFormats
+
+    coerce : S -> %
+    coerce (s:S):$ == makeVariable(s, 0)
+
+    differentiate : $ -> $
+    differentiate v     == differentiate(v, 1)
+
+    differentiate : ($, NonNegativeInteger) -> $
+    differentiate(v, n) == makeVariable(variable v, n + order v)
+
+    retractIfCan : % -> Union(S,"failed")
+    retractIfCan v == (zero?(order v) => variable v; "failed")
+
+    ?=? : (%,%) -> Boolean
+    v = u == (variable v = variable u) and (order v = order u)
+
+    coerce : % -> OutputForm
+    coerce(v:$):OutputForm ==
+      a := variable(v)::OutputForm
+      zero?(nn := order v) => a
+      sub(a, outputForm nn)
+
+    retract : % -> S
+    retract v ==
+      zero?(order v) => variable v
+      error "Not retractable"
+
+    ?<? : (%,%) -> Boolean
+    v < u ==
+      -- the ranking below is orderly, and is the default --
+      order v = order u => variable v < variable u
+      order v < order u
+
+    weight : $ -> NonNegativeInteger
+    weight v == order v
+      --  the default weight is just the order
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{DVARCAT.dotabb}
 "DVARCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DVARCAT"];
@@ -14201,6 +15367,7 @@ DifferentialVariableCategory(S:OrderedSet): Category ==
 "DVARCAT" -> "RETRACT"
 
 \end{chunk}
+
 \begin{chunk}{DVARCAT.dotfull}
 "DifferentialVariableCategory(a:OrderedSet)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DVARCAT"];
@@ -14208,6 +15375,7 @@ DifferentialVariableCategory(S:OrderedSet): Category ==
 "DifferentialVariableCategory(a:OrderedSet)" -> "RetractableTo(OrderedSet)"
 
 \end{chunk}
+
 \begin{chunk}{DVARCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -14244,6 +15412,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ExpressionSpace}{ES}
 \pagepic{ps/v102expressionspace.ps}{ES}{0.35}
@@ -14311,6 +15480,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ExpressionSpace.help}
 ====================================================================
 ExpressionSpace examples
@@ -14771,6 +15941,239 @@ ExpressionSpace(): Category == Defn where
                   and pred?(u::Integer)
 
 \end{chunk}
+
+\begin{chunk}{COQ ES}
+(* category ES *)
+(*
+
+-- the 7 functions not provided are:
+--        kernels   minPoly   definingPolynomial
+--        coerce:K -> %  eval:(%, List K, List %) -> %
+--        subst:(%, List K, List %) -> %
+--        eval:(%, List Symbol, List(List % -> %)) -> %
+
+    oppren := operator(PAREN)$CommonOperators()
+    opbox  := operator(BOX)$CommonOperators()
+
+    box : % -> %
+    box(x:%) == box [x]
+
+    paren : % -> %
+    paren(x:%) == paren [x]
+
+    belong? : OP -> Boolean
+    belong? op == op = oppren or op = opbox
+
+    listk : % -> List K
+    listk f == parts allKernels f
+
+    tower : %  -> List K
+    tower f == sort_! listk f
+
+    allk : List % -> Set K
+    allk l == reduce("union", [allKernels f for f in l], {})
+
+    operators : % -> List OP
+    operators f  == [operator k for k in listk f]
+
+    height : %  -> N
+    height f == reduce("max", [height k for k in kernels f], 0)
+
+    freeOf? : (%, SY) -> Boolean
+    freeOf?(x:%, s:SY) == not member?(s, [name k for k in listk x])
+
+    distribute : % -> %
+    distribute x == unwrap([k for k in listk x | is?(k, oppren)], x)
+
+    box : List % -> %
+    box(l:List %) == opbox l
+
+    paren : List % -> %
+    paren(l:List %) == oppren l
+
+    freeOf? : (%, %)  -> Boolean
+    freeOf?(x:%, k:%) == not member?(retract k, listk x)
+
+    kernel : (OP, %) -> %
+    kernel(op:OP, arg:%) == kernel(op, [arg])
+
+    elt : (OP, %) -> %
+    elt(op:OP, x:%) == op [x]
+
+    elt : (OP, %, %) -> %
+    elt(op:OP, x:%, y:%) == op [x, y]
+
+    elt : (OP, %, %, %) -> %
+    elt(op:OP, x:%, y:%, z:%) == op [x, y, z]
+
+    elt : (OP, %, %, %, %) -> %
+    elt(op:OP, x:%, y:%, z:%, t:%) == op [x, y, z, t]
+
+    eval : (%, SY, List % -> %) -> %
+    eval(x:%, s:SY, f:List % -> %) == eval(x, [s], [f])
+
+    eval : (%, OP, List % -> %) -> %
+    eval(x:%, s:OP, f:List % -> %) == eval(x, [name s], [f])
+
+    eval : (%, SY, % -> %) -> %
+    eval(x:%, s:SY, f:% -> %) == 
+      eval(x, [s], [(y:List %):% +-> f(first y)])
+
+    eval : (%, OP, % -> %) -> %
+    eval(x:%, s:OP, f:% -> %) == 
+      eval(x, [s], [(y:List %):% +-> f(first y)])
+
+    subst : (%, Equation %) -> %
+    subst(x:%, e:Equation %) == subst(x, [e])
+
+    eval : (%, List OP, List(% -> %)) -> %
+    eval(x:%, ls:List OP, lf:List(% -> %)) ==
+      eval(x, ls, [y +-> f(first y) for f in lf]$List(List % -> %))
+
+    eval : (%,List(Symbol),List((% -> %))) -> %
+    eval(x:%, ls:List SY, lf:List(% -> %)) ==
+      eval(x, ls, [y +-> f(first y) for f in lf]$List(List % -> %))
+
+    eval : (%, List SY, List(% -> %)) -> %
+    eval(x:%, ls:List OP, lf:List(List % -> %)) ==
+      eval(x, [name s for s in ls]$List(SY), lf)
+
+    map : (% -> %, K) -> %
+    map(fn, k) ==
+      (l := [fn x for x in argument k]$List(%)) = argument k => k::%
+      (operator k) l
+
+    operator : BasicOperator -> BasicOperator
+    operator op ==
+      is?(op, PAREN) => oppren
+      is?(op, BOX) => opbox
+      error "Unknown operator"
+
+    mainKernel : % -> Union(K, "failed")
+    mainKernel x ==
+      empty?(l := kernels x) => "failed"
+      n := height(k := first l)
+      for kk in rest l repeat
+        if height(kk) > n then
+          n := height kk
+          k := kk
+      k
+
+-- takes all the kernels except for the dummy variables, which are second
+-- arguments of rootOf's, integrals, sums and products which appear only in
+-- their first arguments
+
+    allKernels: % -> Set K
+    allKernels f ==
+      s := brace(l := kernels f)
+      for k in l repeat
+          t :=
+              (u := property(operator k, DUMMYVAR)) case None =>
+                  arg := argument k
+                  s0  := remove_!(retract(second arg)@K, allKernels first arg)
+                  arg := rest rest arg
+                  n   := (u::None) pretend N
+                  if n > 1 then arg := rest arg
+                  union(s0, allk arg)
+              allk argument k
+          s := union(s, t)
+      s
+
+    kernel : (BasicOperator,List(%)) -> %
+    kernel(op:OP, args:List %) ==
+      not belong? op => error "Unknown operator"
+      okkernel(op, args)
+
+    okkernel : (BasicOperator, List %) -> %
+    okkernel(op, l) ==
+      kernel(op, l, 1 + reduce("max", [height f for f in l], 0))$K :: %
+
+    elt : (BasicOperator, List %) -> %
+    elt(op:OP, args:List %) ==
+      not belong? op => error "Unknown operator"
+      ((u := arity op) case N) and (#args ^= u::N)
+                                    => error "Wrong number of arguments"
+      (v := evaluate(op,args)$BasicOperatorFunctions1(%)) case % => v::%
+      okkernel(op, args)
+
+    retract : % -> Kernel(%)
+    retract f ==
+      (k := mainKernel f) case "failed" => error "not a kernel"
+      k::K::% ^= f => error "not a kernel"
+      k::K
+
+    retractIfCan : % -> Union(Kernel(%),"failed")
+    retractIfCan f ==
+      (k := mainKernel f) case "failed" => "failed"
+      k::K::% ^= f => "failed"
+      k
+
+    is? : (%, Symbol) -> Boolean
+    is?(f:%, s:SY) ==
+      (k := retractIfCan f) case "failed" => false
+      is?(k::K, s)
+
+    is? : (%, BasicOperator) -> Boolean
+    is?(f:%, op:OP) ==
+      (k := retractIfCan f) case "failed" => false
+      is?(k::K, op)
+
+    unwrap : (List K, %) -> %
+    unwrap(l, x) ==
+      for k in reverse_! l repeat
+        x := eval(x, k, first argument k)
+      x
+
+    distribute : (%, %) -> %
+    distribute(x, y) ==
+      ky := retract y
+      unwrap([k for k in listk x |
+              is?(k, "%paren"::SY) and member?(ky, listk(k::%))], x)
+
+    -- in case of conflicting substitutions e.g. [x = a, x = b],
+    -- the first one prevails.
+    -- this is not part of the semantics of the function, but just
+    -- a feature of this implementation.
+
+    eval : (%,List(Equation(%))) -> %
+    eval(f:%, leq:List Equation %) ==
+      rec := mkKerLists leq
+      eval(f, rec.lstk, rec.lstv)
+
+    subst : (%, List Equation %) -> %
+    subst(f:%, leq:List Equation %) ==
+      rec := mkKerLists leq
+      subst(f, rec.lstk, rec.lstv)
+
+    mkKerLists: List Equation % -> Record(lstk: List K, lstv:List %)
+    mkKerLists leq ==
+      lk := empty()$List(K)
+      lv := empty()$List(%)
+      for eq in leq repeat
+        (k := retractIfCan(lhs eq)@Union(K, "failed")) case "failed" =>
+                          error "left hand side must be a single kernel"
+        if not member?(k::K, lk) then
+          lk := concat(k::K, lk)
+          lv := concat(rhs eq, lv)
+      [lk, lv]
+
+    if % has RetractableTo Integer then
+
+      even?: % -> Boolean
+      even? x == intpred?(x, even?)
+
+      odd? : % -> Boolean
+      odd? x  == intpred?(x, odd?)
+
+      intpred?: (%, Integer -> Boolean) -> Boolean
+      intpred?(x, pred?) ==
+           (u := retractIfCan(x)@Union(Integer, "failed")) case Integer
+                  and pred?(u::Integer)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ES.dotabb}
 "ES"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ES"];
@@ -14780,6 +16183,7 @@ ExpressionSpace(): Category == Defn where
 "ES" -> "EVALAB"
 
 \end{chunk}
+
 \begin{chunk}{ES.dotfull}
 "ExpressionSpace()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ES"];
@@ -14790,6 +16194,7 @@ ExpressionSpace(): Category == Defn where
 "ExpressionSpace()" -> "Evalable(ExpressionSpace)"
 
 \end{chunk}
+
 \begin{chunk}{ES.dotpic}
 digraph pic {
  fontsize=10;
@@ -14846,6 +16251,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{GradedAlgebra}{GRALG}
 \pagepic{ps/v102gradedalgebra.ps}{GRALG}{0.75}
@@ -14882,6 +16288,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{GradedAlgebra.help}
 ====================================================================
 GradedAlgebra examples
@@ -14997,6 +16404,28 @@ GradedAlgebra(R: CommutativeRing, E: AbelianMonoid): Category ==
       (x: %)*(r: R) == product(x, r::%)
 
 \end{chunk}
+
+\begin{chunk}{COQ GRALG}
+(* category GRALG *)
+(*
+   if not (R is %) then
+
+      0 : () -> %
+      0: % == (0$R)::%
+
+      1 : () -> %
+      1: % == 1$R::%
+
+      ?*? : (R,%) -> %
+      (r: R)*(x: %) == product(r::%, x)
+
+      ?*? : (%,R) -> %
+      (x: %)*(r: R) == product(x, r::%)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{GRALG.dotabb}
 "GRALG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=GRALG"];
@@ -15004,6 +16433,7 @@ GradedAlgebra(R: CommutativeRing, E: AbelianMonoid): Category ==
 "GRALG" -> "RETRACT"
 
 \end{chunk}
+
 \begin{chunk}{GRALG.dotfull}
 "GradedAlgebra(a:CommutativeRing,b:AbelianMonoid)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=GRALG"];
@@ -15012,6 +16442,7 @@ GradedAlgebra(R: CommutativeRing, E: AbelianMonoid): Category ==
 "GradedAlgebra(a:CommutativeRing,b:AbelianMonoid)" ->
     "RetractableTo(CommutativeRing)"
 \end{chunk}
+
 \begin{chunk}{GRALG.dotpic}
 digraph pic {
  fontsize=10;
@@ -15051,6 +16482,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{IndexedAggregate}{IXAGG}
 \pagepic{ps/v102indexedaggregate.ps}{IXAGG}{0.90}
@@ -15113,6 +16545,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{IndexedAggregate.help}
 ====================================================================
 IndexedAggregate examples
@@ -15343,12 +16776,68 @@ IndexedAggregate(Index: SetCategory, Entry: Type): Category ==
       void
 
 \end{chunk}
+
+\begin{chunk}{COQ IXAGG}
+(* category IXAGG *)
+(*
+
+  elt : (%,Index,Entry) -> Entry
+  elt(a, i, x) == (index?(i, a) => qelt(a, i); x)
+
+  if % has finiteAggregate then
+
+    entries: % -> List Entry
+    entries x == parts x
+
+    if Entry has SetCategory then
+
+      entry?: (Entry,%) -> Boolean
+      entry?(x, a) == member?(x, a)
+
+  if Index has OrderedSet then
+
+    maxIndex: % -> Index
+    maxIndex a == "max"/indices(a)
+
+    minIndex: % -> Index
+    minIndex a == "min"/indices(a)
+
+    first : % -> Entry
+    first a  == a minIndex a
+
+  if % has shallowlyMutable then
+
+    map : ((Entry -> Entry),%) -> %
+    map(f, a) == map_!(f, copy a)
+
+    map! : ((Entry -> Entry),%) -> %
+    map_!(f, a) ==
+      for i in indices a repeat qsetelt_!(a, i, f qelt(a, i))
+      a
+
+    fill_!: (%,Entry) -> %
+    fill_!(a, x) ==
+      for i in indices a repeat qsetelt_!(a, i, x)
+      a
+
+    swap_!: (%,Index,Index) -> Void
+    swap_!(a, i, j) ==
+      t := a.i
+      qsetelt_!(a, i, a.j)
+      qsetelt_!(a, j, t)
+      void
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{IXAGG.dotabb}
 "IXAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=IXAGG"];
 "IXAGG" -> "HOAGG"
 "IXAGG" -> "ELTAGG"
 
 \end{chunk}
+
 \begin{chunk}{IXAGG.dotfull}
 "IndexedAggregate(a:SetCategory,b:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=IXAGG"];
@@ -15368,6 +16857,7 @@ IndexedAggregate(Index: SetCategory, Entry: Type): Category ==
     "IndexedAggregate(a:SetCategory,b:Type)"
 
 \end{chunk}
+
 \begin{chunk}{IXAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -15399,6 +16889,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{MonadWithUnit}{MONADWU}
 \pagepic{ps/v102monadwithunit.ps}{MONADWU}{0.75}
@@ -15437,6 +16928,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{MonadWithUnit.help}
 ====================================================================
 MonadWithUnit examples
@@ -15589,18 +17081,58 @@ MonadWithUnit(): Category == Monad with
         res
 
 \end{chunk}
+
+\begin{chunk}{COQ MONADWU}
+(* category MONADWU *)
+(*
+
+Axioms:
+ leftIdentity("*":(%,%)->%,1)      1*x=x
+ rightIdentity("*":(%,%)->%,1)     x*1=x
+ unitsKnown - if "recip" says "failed", it PROVES input wasn't a unit
+
+      import RepeatedSquaring(%)
+
+      one?: % -> Boolean
+      one? x == x = 1
+
+      "**": (%,NonNegativeInteger) -> %
+      x:% ** n:NonNegativeInteger ==
+         zero? n => 1
+         expt(x,n pretend PositiveInteger)
+
+      rightPower: (%,NonNegativeInteger) -> %
+      rightPower(a,n) ==
+        zero? n => 1
+        res := 1
+        for i in 1..n repeat res := res * a
+        res
+
+      leftPower: (%,NonNegativeInteger) -> %
+      leftPower(a,n) ==
+        zero? n => 1
+        res := 1
+        for i in 1..n repeat res := a * res
+        res
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{MONADWU.dotabb}
 "MONADWU"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MONADWU"];
 "MONADWU" -> "MONAD"
 
 \end{chunk}
+
 \begin{chunk}{MONADWU.dotfull}
 "MonadWithUnit()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MONADWU"];
 "MonadWithUnit()" -> "Monad()"
 
 \end{chunk}
+
 \begin{chunk}{MONADWU.dotpic}
 digraph pic {
  fontsize=10;
@@ -15640,6 +17172,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Monoid}{MONOID}
 \pagepic{ps/v102monoid.ps}{MONOID}{0.75}
@@ -15674,6 +17207,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Monoid.help}
 ====================================================================
 Monoid examples
@@ -15787,18 +17321,53 @@ Monoid(): Category == SemiGroup with
          expt(x,n pretend PositiveInteger)
 
 \end{chunk}
+
+\begin{chunk}{COQ MONOID}
+(* category MONOID *)
+(*
+Axioms:
+  leftIdentity("*":(%,%)->%,1)     1*x=x
+  rightIdentity("*":(%,%)->%,1)    x*1=x
+
+      import RepeatedSquaring(%)
+
+      "^" : (%,NonNegativeInteger) -> %   
+      _^(x:%, n:NonNegativeInteger):% == x ** n
+
+      one?: % -> Boolean
+      one? x == x = 1
+
+      sample: constant -> %
+      sample() == 1
+
+      recip: % -> Union(%,"failed")
+      recip x ==
+        (x = 1) => x
+        "failed"
+
+      "**": (%,NonNegativeInteger) -> %
+      x:% ** n:NonNegativeInteger ==
+         zero? n => 1
+         expt(x,n pretend PositiveInteger)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{MONOID.dotabb}
 "MONOID"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MONOID"];
 "MONOID" -> "SGROUP"
 
 \end{chunk}
+
 \begin{chunk}{MONOID.dotfull}
 "Monoid()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MONOID"];
 "Monoid()" -> "SemiGroup()"
 
 \end{chunk}
+
 \begin{chunk}{MONOID.dotpic}
 digraph pic {
  fontsize=10;
@@ -15838,6 +17407,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OrderedFinite}{ORDFIN}
 \pagepic{ps/v102orderedfinite.ps}{ORDFIN}{1.00}
@@ -15873,6 +17443,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OrderedFinite.help}
 ====================================================================
 OrderedFinite examples
@@ -15940,6 +17511,7 @@ These exports come from \refto{Finite}():
 OrderedFinite(): Category == Join(OrderedSet, Finite)
 
 \end{chunk}
+
 \begin{chunk}{ORDFIN.dotabb}
 "ORDFIN"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDFIN"];
@@ -15947,6 +17519,7 @@ OrderedFinite(): Category == Join(OrderedSet, Finite)
 "ORDFIN" -> "FINITE"
 
 \end{chunk}
+
 \begin{chunk}{ORDFIN.dotfull}
 "OrderedFinite()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDFIN"];
@@ -15954,6 +17527,7 @@ OrderedFinite(): Category == Join(OrderedSet, Finite)
 "OrderedFinite()" -> "Finite()"
 
 \end{chunk}
+
 \begin{chunk}{ORDFIN.dotpic}
 digraph pic {
  fontsize=10;
@@ -15987,6 +17561,7 @@ digraph pic {
 
 }
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PlacesCategory}{PLACESC}
 \pagepic{ps/v102placescategory.eps}{PLACESC}{0.75}
@@ -16030,6 +17605,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PlacesCategory.help}
 ====================================================================
 PlacesCategory examples
@@ -16164,17 +17740,20 @@ PlacesCategory(K:Field,PCS:LocalPowerSeriesCategory(K)):Category
       ++ correspnd to a simple point
 
 \end{chunk}
+
 \begin{chunk}{PLACESC.dotabb}
 "PLACESC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PLACESC"];
 "SETCATD" [color="#4488FF",href="bookvol10.2.pdf#nameddest=SETCATD"]
 "PLACESC" -> "SETCATD"
 
 \end{chunk}
+
 \begin{chunk}{PLACESC.dotfull}
 "PlacesCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=PLACESC"];
 "PlacesCategory()" -> "SetCategoryWithDegree()"
 
 \end{chunk}
+
 \begin{chunk}{PLACESC.dotpic}
 digraph pic {
  fontsize=10;
@@ -16209,6 +17788,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ProjectiveSpaceCategory}{PRSPCAT}
 \pagepic{ps/v102projectivespacecategory.ps}{PRSPCAT}{0.75}
@@ -16252,6 +17832,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ProjectiveSpaceCategory.help}
 ====================================================================
 ProjectiveSpaceCategory examples
@@ -16414,18 +17995,21 @@ ProjectiveSpaceCategory(K:Field):Category == Implementation where
      ++ of origin that represent an infinitly close point
 
 \end{chunk}
+
 \begin{chunk}{PRSPCAT.dotabb}
 "PRSPCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PRSPCAT"];
 "PRSPCAT" -> "SETCATD"
 
 \end{chunk}
+
 \begin{chunk}{PRSPCAT.dotfull}
 "ProjectiveSpaceCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PRSPCAT"];
 "ProjectiveSpaceCategory()" -> "SetCategoryWithDegree()"
 
 \end{chunk}
+
 \begin{chunk}{PRSPCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -16460,6 +18044,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{RecursiveAggregate}{RCAGG}
 \pagepic{ps/v102recursiveaggregate.ps}{RCAGG}{1.00}
@@ -16520,6 +18105,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{RecursiveAggregate.help}
 ====================================================================
 RecursiveAggregate examples
@@ -16716,17 +18302,41 @@ RecursiveAggregate(S:Type): Category == HomogeneousAggregate(S) with
      child?(x,l) == member?(x,children(l))
 
 \end{chunk}
+
+\begin{chunk}{COQ RCAGG}
+(* category RCAGG *)
+(*
+
+   elt: (%,"value") -> S
+   elt(x,"value") == value x
+
+   if % has shallowlyMutable then
+
+     setelt: (%,"value",S) -> S
+     setelt(x,"value",y) == setvalue_!(x,y)
+
+   if S has SetCategory then
+
+     child?: (%,%) -> Boolean
+     child?(x,l) == member?(x,children(l))
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{RCAGG.dotabb}
 "RCAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=RCAGG"];
 "RCAGG" -> "HOAGG"
 
 \end{chunk}
+
 \begin{chunk}{RCAGG.dotfull}
 "RecursiveAggregate(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RCAGG"];
 "RecursiveAggregate(a:Type)" -> "HomogeneousAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{RCAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -16749,6 +18359,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{TwoDimensionalArrayCategory}{ARR2CAT}
 \pagepic{ps/v102twodimensionalarraycategory.ps}{ARR2CAT}{0.65}
@@ -16819,6 +18430,7 @@ first column in an array and vice versa.
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{TwoDimensionalArrayCategory.help}
 ====================================================================
 TwoDimensionalArrayCategory examples
@@ -17306,12 +18918,201 @@ TwoDimensionalArrayCategory(R,Row,Col): Category == Definition where
         matrix l
 
 \end{chunk}
+
+\begin{chunk}{COQ ARR2CAT}
+(* category ARR2CAT *)
+(*
+
+--% Predicates
+
+    any? : ((R -> Boolean),%) -> Boolean
+    any?(f,m) ==
+      for i in minRowIndex(m)..maxRowIndex(m) repeat
+        for j in minColIndex(m)..maxColIndex(m) repeat
+          f(qelt(m,i,j)) => return true
+      false
+
+    every? : ((R -> Boolean),%) -> Boolean
+    every?(f,m) ==
+      for i in minRowIndex(m)..maxRowIndex(m) repeat
+        for j in minColIndex(m)..maxColIndex(m) repeat
+          not f(qelt(m,i,j)) => return false
+      true
+
+    size? : (%,NonNegativeInteger) -> Boolean
+    size?(m,n) == nrows(m) * ncols(m) = n
+
+    less? : (%,NonNegativeInteger) -> Boolean
+    less?(m,n) == nrows(m) * ncols(m) < n
+
+    more? : (%,NonNegativeInteger) -> Boolean
+    more?(m,n) == nrows(m) * ncols(m) > n
+
+--% Size inquiries
+
+    #? : % -> NonNegativeInteger
+    # m == nrows(m) * ncols(m)
+
+--% Part extractions
+
+    elt: (%,Integer,Integer,R) -> R
+    elt(m,i,j,r) ==
+      i < minRowIndex(m) or i > maxRowIndex(m) => r
+      j < minColIndex(m) or j > maxColIndex(m) => r
+      qelt(m,i,j)
+
+    count : ((R -> Boolean),%) -> NonNegativeInteger
+    count(f:R -> Boolean,m:%) ==
+      num : NonNegativeInteger := 0
+      for i in minRowIndex(m)..maxRowIndex(m) repeat
+        for j in minColIndex(m)..maxColIndex(m) repeat
+          if f(qelt(m,i,j)) then num := num + 1
+      num
+
+    parts: % -> List R
+    parts m ==
+      entryList : List R := nil()
+      for i in maxRowIndex(m)..minRowIndex(m) by -1 repeat
+        for j in maxColIndex(m)..minColIndex(m) by -1 repeat
+          entryList := concat(qelt(m,i,j),entryList)
+      entryList
+
+--% Creation
+
+    copy : % -> %
+    copy m ==
+      ans := new(nrows m,ncols m,NIL$Lisp)
+      for i in minRowIndex(m)..maxRowIndex(m) repeat
+        for j in minColIndex(m)..maxColIndex(m) repeat
+          qsetelt_!(ans,i,j,qelt(m,i,j))
+      ans
+
+    fill_!: (%,R) -> %
+    fill_!(m,r) ==
+      for i in minRowIndex(m)..maxRowIndex(m) repeat
+        for j in minColIndex(m)..maxColIndex(m) repeat
+          qsetelt_!(m,i,j,r)
+      m
+
+   map: (R -> R,%) -> %
+   map(f,m) ==
+      ans := new(nrows m,ncols m,NIL$Lisp)
+      for i in minRowIndex(m)..maxRowIndex(m) repeat
+        for j in minColIndex(m)..maxColIndex(m) repeat
+          qsetelt_!(ans,i,j,f(qelt(m,i,j)))
+      ans
+
+    map_!: (R -> R,%) -> %
+    map_!(f,m) ==
+      for i in minRowIndex(m)..maxRowIndex(m) repeat
+        for j in minColIndex(m)..maxColIndex(m) repeat
+          qsetelt_!(m,i,j,f(qelt(m,i,j)))
+      m
+
+    map:((R,R) -> R,%,%) -> %
+    map(f,m,n) ==
+      (nrows(m) ^= nrows(n)) or (ncols(m) ^= ncols(n)) =>
+        error "map: arguments must have same dimensions"
+      ans := new(nrows m,ncols m,NIL$Lisp)
+      for i in minRowIndex(m)..maxRowIndex(m) repeat
+        for j in minColIndex(m)..maxColIndex(m) repeat
+          qsetelt_!(ans,i,j,f(qelt(m,i,j),qelt(n,i,j)))
+      ans
+
+    map:((R,R) -> R,%,%,R) -> %
+    map(f,m,n,r) ==
+      maxRow := max(maxRowIndex m,maxRowIndex n)
+      maxCol := max(maxColIndex m,maxColIndex n)
+      ans := new(max(nrows m,nrows n),max(ncols m,ncols n),NIL$Lisp)
+      for i in minRowIndex(m)..maxRow repeat
+        for j in minColIndex(m)..maxCol repeat
+          qsetelt_!(ans,i,j,f(elt(m,i,j,r),elt(n,i,j,r)))
+      ans
+
+    setRow_!: (%,Integer,Row) -> %
+    setRow_!(m,i,v) ==
+      i < minRowIndex(m) or i > maxRowIndex(m) =>
+        error "setRow!: index out of range"
+      for j in minColIndex(m)..maxColIndex(m) _
+        for k in minIndex(v)..maxIndex(v) repeat
+          qsetelt_!(m,i,j,v.k)
+      m
+
+    setColumn_!: (%,Integer,Col) -> %
+    setColumn_!(m,j,v) ==
+      j < minColIndex(m) or j > maxColIndex(m) =>
+        error "setColumn!: index out of range"
+      for i in minRowIndex(m)..maxRowIndex(m) _
+        for k in minIndex(v)..maxIndex(v) repeat
+          qsetelt_!(m,i,j,v.k)
+      m
+
+    if R has _= : (R,R) -> Boolean then
+
+      ?=? : (%,%) -> Boolean
+      m = n ==
+        eq?(m,n) => true
+        (nrows(m) ^= nrows(n)) or (ncols(m) ^= ncols(n)) => false
+        for i in minRowIndex(m)..maxRowIndex(m) repeat
+          for j in minColIndex(m)..maxColIndex(m) repeat
+            not (qelt(m,i,j) = qelt(n,i,j)) => return false
+        true
+
+      member? : (R,%) -> Boolean
+      member?(r,m) ==
+        for i in minRowIndex(m)..maxRowIndex(m) repeat
+          for j in minColIndex(m)..maxColIndex(m) repeat
+            qelt(m,i,j) = r => return true
+        false
+
+      count : (R,%) -> NonNegativeInteger
+      count(r:R,m:%) == count(x +-> x = r,m)
+
+    if Row has shallowlyMutable then
+
+      row: (%,Integer) -> Row
+      row(m,i) ==
+        i < minRowIndex(m) or i > maxRowIndex(m) =>
+          error "row: index out of range"
+        v : Row := new(ncols m,NIL$Lisp)
+        for j in minColIndex(m)..maxColIndex(m) _
+          for k in minIndex(v)..maxIndex(v) repeat
+            qsetelt_!(v,k,qelt(m,i,j))
+        v
+
+    if Col has shallowlyMutable then
+
+      column: (%,Integer) -> Col
+      column(m,j) ==
+        j < minColIndex(m) or j > maxColIndex(m) =>
+          error "column: index out of range"
+        v : Col := new(nrows m,NIL$Lisp)
+        for i in minRowIndex(m)..maxRowIndex(m) _
+          for k in minIndex(v)..maxIndex(v) repeat
+            qsetelt_!(v,k,qelt(m,i,j))
+        v
+
+    if R has CoercibleTo(OutputForm) then
+
+      coerce : % -> OutputForm
+      coerce(m:%) ==
+        l : List List OutputForm
+        l := [[qelt(m,i,j) :: OutputForm _
+                  for j in minColIndex(m)..maxColIndex(m)] _
+                  for i in minRowIndex(m)..maxRowIndex(m)]
+        matrix l
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ARR2CAT.dotabb}
 "ARR2CAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ARR2CAT"];
 "ARR2CAT" -> "HOAGG"
 
 \end{chunk}
+
 \begin{chunk}{ARR2CAT.dotfull}
 "TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ARR2CAT"];
@@ -17324,6 +19125,7 @@ TwoDimensionalArrayCategory(R,Row,Col): Category == Definition where
 -> "TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))"
 
 \end{chunk}
+
 \begin{chunk}{ARR2CAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -17366,6 +19168,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 5}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{BinaryRecursiveAggregate}{BRAGG}
@@ -17433,6 +19236,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{BinaryRecursiveAggregate.help}
 ====================================================================
 BinaryRecursiveAggregate examples
@@ -17689,11 +19493,127 @@ BinaryRecursiveAggregate(S:Type):Category == RecursiveAggregate S with
      setelt(x,"right",b) == setright_!(x,b)
 
 \end{chunk}
+
+\begin{chunk}{COQ BRAGG}
+(* category BRAGG *)
+(*
+   cycleMax ==> 1000
+
+   elt: (%,"left") -> %
+   elt(x,"left")  == left x
+
+   elt: (%,"right") -> %
+   elt(x,"right") == right x
+
+   leaf? : % -> Boolean
+   leaf? x == empty? x or empty? left x and empty? right x
+
+   leaves : % -> List(S)
+   leaves t ==
+     empty? t => empty()$List(S)
+     leaf? t => [value t]
+     concat(leaves left t,leaves right t)
+
+   nodes : % -> List(%)
+   nodes x ==
+     l := empty()$List(%)
+     empty? x => l
+     concat(nodes left x,concat([x],nodes right x))
+
+   children : % -> List(%)
+   children x ==
+     l := empty()$List(%)
+     empty? x => l
+     empty? left x  => [right x]
+     empty? right x => [left x]
+     [left x, right x]
+
+   if % has SetAggregate(S) and S has SetCategory then
+
+     node? : (%,%) -> Boolean
+     node?(u,v) ==
+       empty? v => false
+       u = v => true
+       for y in children v repeat node?(u,y) => return true
+       false
+
+     ?=? : (%,%) -> Boolean
+     x = y ==
+       empty?(x) => empty?(y)
+       empty?(y) => false
+       value x = value y and left x = left y and right x = right y
+
+     if % has finiteAggregate then
+
+       member? : (S,%) -> Boolean
+       member?(x,u) ==
+         empty? u => false
+         x = value u => true
+         member?(x,left u) or member?(x,right u)
+
+   if S has SetCategory then
+
+     coerce : % -> OutputForm
+     coerce(t:%): OutputForm ==
+       empty? t =>  "[]"::OutputForm
+       v := value(t):: OutputForm
+       empty? left t =>
+         empty? right t => v
+         r := coerce(right t)@OutputForm
+         bracket ["."::OutputForm, v, r]
+       l := coerce(left t)@OutputForm
+       r :=
+         empty? right t => "."::OutputForm
+         coerce(right t)@OutputForm
+       bracket [l, v, r]
+
+   if % has finiteAggregate then
+
+     #? : % -> NonNegativeInteger
+     #x == aggCount(x,0)
+
+     aggCount: (%,NonNegativeInteger) -> NonNegativeInteger
+     aggCount(x,k) ==
+       empty? x => 0
+       k := k + 1
+       k = cycleMax and cyclic? x => error "cyclic tree"
+       for y in children x repeat k := aggCount(y,k)
+       k
+
+   cyclic? : % -> Boolean
+   cyclic? x == not empty? x and isCycle?(x,empty()$(List %))
+
+   isCycle?: (%, List %) -> Boolean
+   isCycle?(x,acc) ==
+     empty? x => false
+     eqMember?(x,acc) => true
+     for y in children x | not empty? y repeat
+       isCycle?(y,acc) => return true
+     false
+
+   eqMember?: (%, List %) -> Boolean
+   eqMember?(y,l) ==
+     for x in l repeat eq?(x,y) => return true
+     false
+
+   if % has shallowlyMutable then
+
+     setelt: (%,"left",%) -> %
+     setelt(x,"left",b)  == setleft_!(x,b)
+
+     setelt: (%,"right",%) -> %
+     setelt(x,"right",b) == setright_!(x,b)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{BRAGG.dotabb}
 "BRAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=BRAGG"];
 "BRAGG" -> "RCAGG"
 
 \end{chunk}
+
 \begin{chunk}{BRAGG.dotfull}
 "BinaryRecursiveAggregate(a:Type)" 
  [color=lightblue,href="bookvol10.2.pdf#nameddest=BRAGG"];
@@ -17705,6 +19625,7 @@ BinaryRecursiveAggregate(S:Type):Category == RecursiveAggregate S with
    "BinaryRecursiveAggregate(a:Type)" 
 
 \end{chunk}
+
 \begin{chunk}{BRAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -17730,6 +19651,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CancellationAbelianMonoid}{CABMON}
 \pagepic{ps/v102cancellationabelianmonoid.ps}{CABMON}{0.75}
@@ -17764,6 +19686,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{CancellationAbelianMonoid.help}
 ====================================================================
 CancellationAbelianMonoid examples
@@ -17837,18 +19760,21 @@ CancellationAbelianMonoid(): Category == AbelianMonoid with
          ++ or "failed" if no such element exists.
 
 \end{chunk}
+
 \begin{chunk}{CABMON.dotabb}
 "CABMON"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=CABMON"];
 "CABMON" -> "ABELMON"
 
 \end{chunk}
+
 \begin{chunk}{CABMON.dotfull}
 "CancellationAbelianMonoid()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=CABMON"];
 "CancellationAbelianMonoid()" -> "AbelianMonoid()"
 
 \end{chunk}
+
 \begin{chunk}{CABMON.dotpic}
 digraph pic {
  fontsize=10;
@@ -17891,6 +19817,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{DictionaryOperations}{DIOPS}
 \pagepic{ps/v102dictionaryoperations.ps}{DIOPS}{1.00}
@@ -17957,6 +19884,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{DictionaryOperations.help}
 ====================================================================
 DictionaryOperations examples
@@ -18149,12 +20077,38 @@ DictionaryOperations(S:SetCategory): Category ==
                                       [x::OutputForm for x in parts s])
 
 \end{chunk}
+
+\begin{chunk}{COQ DIOPS}
+(* category DIOPS *)
+(*
+
+   construct : List(S) -> %
+   construct l == dictionary l
+
+   dictionary: () -> %
+   dictionary() == empty()
+
+   if % has finiteAggregate then
+
+     copy : % -> %
+     copy d == dictionary parts d
+
+     coerce : % -> OutputForm
+     coerce(s:%):OutputForm ==
+       prefix("dictionary"@String :: OutputForm,
+                                      [x::OutputForm for x in parts s])
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{DIOPS.dotabb}
 "DIOPS" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIOPS"];
 "DIOPS" -> "BGAGG"
 "DIOPS" -> "CLAGG"
 
 \end{chunk}
+
 \begin{chunk}{DIOPS.dotfull}
 "DictionaryOperations(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DIOPS"];
@@ -18162,6 +20116,7 @@ DictionaryOperations(S:SetCategory): Category ==
 "DictionaryOperations(a:SetCategory)" -> "Collection(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{DIOPS.dotpic}
 digraph pic {
  fontsize=10;
@@ -18197,6 +20152,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{DoublyLinkedAggregate}{DLAGG}
 \pagepic{ps/v102doublylinkedaggregate.ps}{DLAGG}{1.00}
@@ -18262,6 +20218,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{DoublyLinkedAggregate.help}
 ====================================================================
 DoublyLinkedAggregate examples
@@ -18448,17 +20405,20 @@ DoublyLinkedAggregate(S:Type): Category == RecursiveAggregate S with
         ++ aggregate u to v, returning v.
 
 \end{chunk}
+
 \begin{chunk}{DLAGG.dotabb}
 "DLAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=DLAGG"];
 "DLAGG" -> "RCAGG"
 
 \end{chunk}
+
 \begin{chunk}{DLAGG.dotfull}
 "DoublyLinkedAggregate(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DLAGG"];
 "DoublyLinkedAggregate(a:Type)" -> "RecursiveAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{DLAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -18521,6 +20481,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Group.help}
 ====================================================================
 Group examples
@@ -18643,18 +20604,55 @@ Group(): Category == Monoid with
       commutator(p,q) == inv(p) * inv(q) * p * q
 
 \end{chunk}
+
+\begin{chunk}{COQ GROUP}
+(* category GROUP *)
+(*
+Axioms:
+  leftInverse("*":(%,%)->%,inv)   inv(x)*x = 1
+  rightInverse("*":(%,%)->%,inv)  x*inv(x) = 1 
+
+      import RepeatedSquaring(%)
+
+      "/": (%,%) -> %           
+      x:% / y:% == x*inv(y)
+
+      recip : % -> Union(%,"failed")
+      recip(x:%) == inv(x)
+
+      "^": (%,Integer) -> %     
+      _^(x:%, n:Integer):% == x ** n
+
+      "**": (%,Integer) -> %    
+      x:% ** n:Integer ==
+         zero? n => 1
+         n<0 => expt(inv(x),(-n) pretend PositiveInteger)
+         expt(x,n pretend PositiveInteger)
+
+      conjugate: (%,%) -> %
+      conjugate(p,q) == inv(q) * p * q
+
+      commutator: (%,%) -> %
+      commutator(p,q) == inv(p) * inv(q) * p * q
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{GROUP.dotabb}
 "GROUP"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=GROUP"];
 "GROUP" -> "MONOID"
 
 \end{chunk}
+
 \begin{chunk}{GROUP.dotfull}
 "Group()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=GROUP"];
 "Group()" -> "Monoid()"
 
 \end{chunk}
+
 \begin{chunk}{GROUP.dotpic}
 digraph pic {
  fontsize=10;
@@ -18701,6 +20699,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{LinearAggregate}{LNAGG}
 \pagepic{ps/v102linearaggregate.ps}{LNAGG}{0.90}
@@ -18780,6 +20779,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{LinearAggregate.help}
 ====================================================================
 LinearAggregate examples
@@ -19049,12 +21049,44 @@ LinearAggregate(S:Type): Category ==
 --if % has shallowlyMutable then new(n, s)  == fill_!(new n, s)
 
 \end{chunk}
+
+\begin{chunk}{COQ LNAGG}
+(* category LNAGG *)
+(*
+
+  indices : % -> List(Integer)
+  indices a == [i for i in minIndex a .. maxIndex a]
+
+  index? : (Integer,%) -> Boolean
+  index?(i, a) == i >= minIndex a and i <= maxIndex a
+
+  concat: (%,S) -> %
+  concat(a:%, x:S) == concat(a, new(1, x))
+
+  concat: (S,%) -> %
+  concat(x:S, y:%) == concat(new(1, x), y)
+
+  insert: (S,%,Integer) -> %
+  insert(x:S, a:%, i:Integer) == insert(new(1, x), a, i)
+
+  if % has finiteAggregate then
+
+    maxIndex : % -> Integer
+    maxIndex l == #l - 1 + minIndex l
+
+--if % has shallowlyMutable then new(n, s)  == fill_!(new n, s)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{LNAGG.dotabb}
 "LNAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=LNAGG"];
 "LNAGG" -> "IXAGG"
 "LNAGG" -> "CLAGG"
 
 \end{chunk}
+
 \begin{chunk}{LNAGG.dotfull}
 "LinearAggregate(a:Type)" 
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LNAGG"];
@@ -19062,6 +21094,7 @@ LinearAggregate(S:Type): Category ==
 "LinearAggregate(a:Type)" -> "Collection(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{LNAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -19096,6 +21129,7 @@ digraph pic {
 
 }
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{MatrixCategory}{MATCAT}
 \pagepic{ps/v102matrixcategory.ps}{MATCAT}{0.60}
@@ -19993,6 +22027,7 @@ inverse matrix [[j**i for i in 0..4] for j in 1..5]
 )lisp (bye)
  
 \end{chunk}
+
 \begin{chunk}{MatrixCategory.help}
 ====================================================================
 MatrixCategory examples
@@ -21262,163 +23297,611 @@ MatrixCategory(R,Row,Col): Category == Definition where
          positivePower(xInv :: %,-n)
 
 \end{chunk}
-\begin{chunk}{MATCAT.dotabb}
-"MATCAT"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=MATCAT"];
-"MATCAT" -> "ARR2CAT"
-
-\end{chunk}
-\begin{chunk}{MATCAT.dotfull}
-"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" 
- [color=lightblue,href="bookvol10.2.pdf#nameddest=MATCAT"];
-"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)"
- ->
-"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))"
 
-\end{chunk}
-\begin{chunk}{MATCAT.dotpic}
-digraph pic {
- fontsize=10;
- bgcolor="#ECEA81";
- node [shape=box, color=white, style=filled];
+\begin{chunk}{COQ MATCAT}
+(* category MATCAT *)
+(*
+     minr ==> minRowIndex
+     maxr ==> maxRowIndex
+     minc ==> minColIndex
+     maxc ==> maxColIndex
+     mini ==> minIndex
+     maxi ==> maxIndex
 
-"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" 
- [color=lightblue];
-"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)"
- ->
-"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))"
+--% Predicates
 
-"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))"
- [color=lightblue];
-"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))"
-    -> "HomogeneousAggregate(a:Type)"
+     square?  : % -> Boolean
+     square? x == nrows x = ncols x
 
-"HomogeneousAggregate(a:Type)" [color=lightblue];
-"HomogeneousAggregate(a:Type)" -> "Aggregate()"
-"HomogeneousAggregate(a:Type)" -> "Evalable(a:Type)"
-"HomogeneousAggregate(a:Type)" -> "SetCategory()"
+     diagonal?: % -> Boolean
+     diagonal? x ==
+       not square? x => false
+       for i in minr x .. maxr x repeat
+         for j in minc x .. maxc x | (j - minc x) ^= (i - minr x) repeat
+           not zero? qelt(x, i, j) => return false
+       true
 
-"Evalable(a:Type)" [color="#00EE00"];
+     symmetric?: % -> Boolean
+     symmetric? x ==
+       (nRows := nrows x) ^= ncols x => false
+       mr := minRowIndex x; mc := minColIndex x
+       for i in 0..(nRows - 1) repeat
+         for j in (i + 1)..(nRows - 1) repeat
+           qelt(x,mr + i,mc + j) ^= qelt(x,mr + j,mc + i) => return false
+       true
 
-"SetCategory()" [color=lightblue];
-"SetCategory()" -> "BasicType()"
-"SetCategory()" -> "CoercibleTo(OutputForm)"
+     antisymmetric?: % -> Boolean
+     antisymmetric? x ==
+       (nRows := nrows x) ^= ncols x => false
+       mr := minRowIndex x; mc := minColIndex x
+       for i in 0..(nRows - 1) repeat
+         for j in i..(nRows - 1) repeat
+           qelt(x,mr + i,mc + j) ^= -qelt(x,mr + j,mc + i) =>
+             return false
+       true
 
-"BasicType()" [color=lightblue];
-"BasicType()" -> "Category"
+--% Creation of matrices
 
-"CoercibleTo(OutputForm)" [color=seagreen];
-"CoercibleTo(OutputForm)" -> "CoercibleTo(a:Type)"
+     zero: (NonNegativeInteger,NonNegativeInteger) -> %
+     zero(rows,cols) == new(rows,cols,0)
 
-"CoercibleTo(a:Type)" [color=lightblue];
-"CoercibleTo(a:Type)" -> "Category"
+     matrix: List List R -> %
+     matrix(l: List List R) ==
+       null l => new(0,0,0)
+       -- error check: this is a top level function
+       rows : NonNegativeInteger := 1; cols := # first l
+       cols = 0 => error "matrices with zero columns are not supported"
+       for ll in rest l repeat
+         cols ^= # ll => error "matrix: rows of different lengths"
+         rows := rows + 1
+       ans := new(rows,cols,0)
+       for i in minr(ans)..maxr(ans) for ll in l repeat
+         for j in minc(ans)..maxc(ans) for r in ll repeat
+           qsetelt_!(ans,i,j,r)
+       ans
 
-"Aggregate()" [color=lightblue];
-"Aggregate()" -> "Type()"
+     matrix: (NonNegativeInteger,NonNegativeInteger,(Integer,Integer)->R) -> %
+     matrix(n,m,f) ==
+       mat := new(n,m,0)
+       for i in minr mat..maxr mat repeat
+         for j in minc mat..maxc mat repeat
+           qsetelt!(mat,i,j,f(i,j))
+       mat
 
-"Type()" [color=lightblue];
-"Type()" -> "Category"
+     scalarMatrix: (NonNegativeInteger,R) -> %
+     scalarMatrix(n,r) ==
+       ans := zero(n,n)
+       for i in minr(ans)..maxr(ans) for j in minc(ans)..maxc(ans) repeat
+         qsetelt_!(ans,i,j,r)
+       ans
 
-"Category" [color=lightblue];
+     diagonalMatrix: List R -> %
+     diagonalMatrix(l: List R) ==
+       n := #l; ans := zero(n,n)
+       for i in minr(ans)..maxr(ans) for j in minc(ans)..maxc(ans) _
+           for r in l repeat qsetelt_!(ans,i,j,r)
+       ans
 
-}
+     diagonalMatrix: List % -> %
+     diagonalMatrix(list: List %) ==
+       rows : NonNegativeInteger := 0
+       cols : NonNegativeInteger := 0
+       for mat in list repeat
+         rows := rows + nrows mat
+         cols := cols + ncols mat
+       ans := zero(rows,cols)
+       loR := minr ans; loC := minc ans
+       for mat in list repeat
+         hiR := loR + nrows(mat) - 1; hiC := loC + nrows(mat) - 1
+         for i in loR..hiR for k in minr(mat)..maxr(mat) repeat
+           for j in loC..hiC for l in minc(mat)..maxc(mat) repeat
+             qsetelt_!(ans,i,j,qelt(mat,k,l))
+         loR := hiR + 1; loC := hiC + 1
+       ans
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\pagehead{OrderedAbelianSemiGroup}{OASGP}
-\pagepic{ps/v102orderedabeliansemigroup.ps}{OASGP}{0.75}
+     coerce: Col -> %
+     coerce(v:Col) ==
+       x := new(#v,1,0)
+       one := minc(x)
+       for i in minr(x)..maxr(x) for k in mini(v)..maxi(v) repeat
+         qsetelt_!(x,i,one,qelt(v,k))
+       x
 
-\begin{chunk}{OrderedAbelianSemiGroup.input}
-)set break resume
-)sys rm -f OrderedAbelianSemiGroup.output
-)spool OrderedAbelianSemiGroup.output
-)set message test on
-)set message auto off
-)clear all
+     transpose: Row -> %
+     transpose(v:Row) ==
+       x := new(1,#v,0)
+       one := minr(x)
+       for j in minc(x)..maxc(x) for k in mini(v)..maxi(v) repeat
+         qsetelt_!(x,one,j,qelt(v,k))
+       x
 
---S 1 of 1
-)show OrderedAbelianSemiGroup
---R 
---R OrderedAbelianSemiGroup  is a category constructor
---R Abbreviation for OrderedAbelianSemiGroup is OASGP 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.2.pamphlet to see algebra source code for OASGP 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
---R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
---R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
---R ?>=? : (%,%) -> Boolean               coerce : % -> OutputForm
---R hash : % -> SingleInteger             latex : % -> String
---R max : (%,%) -> %                      min : (%,%) -> %
---R ?~=? : (%,%) -> Boolean              
---R
---E 1
+     transpose: % -> %
+     transpose(x:%) ==
+       ans := new(ncols x,nrows x,0)
+       for i in minr(ans)..maxr(ans) repeat
+         for j in minc(ans)..maxc(ans) repeat
+           qsetelt_!(ans,i,j,qelt(x,j,i))
+       ans
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{OrderedAbelianSemiGroup.help}
-====================================================================
-OrderedAbelianSemiGroup examples
-====================================================================
+     squareTop: % -> %
+     squareTop x ==
+       nrows x < (cols := ncols x) =>
+         error "squareTop: number of columns exceeds number of rows"
+       ans := new(cols,cols,0)
+       for i in minr(x)..(minr(x) + cols - 1) repeat
+         for j in minc(x)..maxc(x) repeat
+           qsetelt_!(ans,i,j,qelt(x,i,j))
+       ans
 
-Ordered sets which are also abelian semigroups, such that the addition
-preserves the ordering.
+     horizConcat: (%,%) -> %
+     horizConcat(x,y) ==
+       (rows := nrows x) ^= nrows y =>
+         error "HConcat: matrices must have same number of rows"
+       ans := new(rows,(cols := ncols x) + ncols y,0)
+       for i in minr(x)..maxr(x) repeat
+         for j in minc(x)..maxc(x) repeat
+           qsetelt_!(ans,i,j,qelt(x,i,j))
+       for i in minr(y)..maxr(y) repeat
+         for j in minc(y)..maxc(y) repeat
+           qsetelt_!(ans,i,j + cols,qelt(y,i,j))
+       ans
 
-Axiom:
-        x < y => x+z < y+z
+     vertConcat: (%,%) -> %
+     vertConcat(x,y) ==
+       (cols := ncols x) ^= ncols y =>
+         error "HConcat: matrices must have same number of columns"
+       ans := new((rows := nrows x) + nrows y,cols,0)
+       for i in minr(x)..maxr(x) repeat
+         for j in minc(x)..maxc(x) repeat
+           qsetelt_!(ans,i,j,qelt(x,i,j))
+       for i in minr(y)..maxr(y) repeat
+         for j in minc(y)..maxc(y) repeat
+           qsetelt_!(ans,i + rows,j,qelt(y,i,j))
+       ans
 
-See Also:
-o )show OrderedAbelianSemiGroup
+--% Part extraction/assignment
 
-\end{chunk}
-{\bf See:}
+     listOfLists: % -> List List R
+     listOfLists x ==
+       ll : List List R := nil()
+       for i in maxr(x)..minr(x) by -1 repeat
+         l : List R := nil()
+         for j in maxc(x)..minc(x) by -1 repeat
+           l := cons(qelt(x,i,j),l)
+         ll := cons(l,ll)
+       ll
 
-\pageto{OrderedAbelianMonoid}{OAMON}
-\pagefrom{AbelianMonoid}{ABELMON}
-\pagefrom{OrderedSet}{ORDSET}
+     swapRows_!: (%,Integer,Integer) -> %
+     swapRows_!(x,i1,i2) ==
+       (i1 < minr(x)) or (i1 > maxr(x)) or (i2 < minr(x)) or _
+           (i2 > maxr(x)) => error "swapRows!: index out of range"
+       i1 = i2 => x
+       for j in minc(x)..maxc(x) repeat
+         r := qelt(x,i1,j)
+         qsetelt_!(x,i1,j,qelt(x,i2,j))
+         qsetelt_!(x,i2,j,r)
+       x
 
-{\bf Exports:}\\
+     swapColumns_!: (%,Integer,Integer) -> %
+     swapColumns_!(x,j1,j2) ==
+       (j1 < minc(x)) or (j1 > maxc(x)) or (j2 < minc(x)) or _
+           (j2 > maxc(x)) => error "swapColumns!: index out of range"
+       j1 = j2 => x
+       for i in minr(x)..maxr(x) repeat
+         r := qelt(x,i,j1)
+         qsetelt_!(x,i,j1,qelt(x,i,j2))
+         qsetelt_!(x,i,j2,r)
+       x
 
-\begin{tabular}{lllll}
-\cross{OASGP}{0} &
-\cross{OASGP}{coerce} &
-\cross{OASGP}{hash} &
-\cross{OASGP}{latex} &
-\cross{OASGP}{max} \\
-\cross{OASGP}{min} &
-\cross{OASGP}{sample} &
-\cross{OASGP}{zero?} &
-\cross{OASGP}{?\~{}=?} &
-\cross{OASGP}{?*?} \\
-\cross{OASGP}{?+?} &
-\cross{OASGP}{?$<$?} &
-\cross{OASGP}{?$<=$?} &
-\cross{OASGP}{?=?} &
-\cross{OASGP}{?$>$?} \\
-\cross{OASGP}{?$>=$?} &&&&
-\end{tabular}
+     elt : (%,List(Integer),List(Integer)) -> %
+     elt(x:%,rowList:List Integer,colList:List Integer) ==
+       for ei in rowList repeat
+         (ei < minr(x)) or (ei > maxr(x)) =>
+           error "elt: index out of range"
+       for ej in colList repeat
+         (ej < minc(x)) or (ej > maxc(x)) =>
+           error "elt: index out of range"
+       y := new(# rowList,# colList,0)
+       for ei in rowList for i in minr(y)..maxr(y) repeat
+         for ej in colList for j in minc(y)..maxc(y) repeat
+           qsetelt_!(y,i,j,qelt(x,ei,ej))
+       y
 
-These exports come from \refto{OrderedSet}():
-\begin{verbatim}
- coerce : % -> OutputForm              
- hash : % -> SingleInteger
- latex : % -> String                   
- max : (%,%) -> %
- min : (%,%) -> %                      
- ?<? : (%,%) -> Boolean                
- ?>? : (%,%) -> Boolean
- ?<=? : (%,%) -> Boolean
- ?>=? : (%,%) -> Boolean               
- ?=? : (%,%) -> Boolean                
- ?~=? : (%,%) -> Boolean
-\end{verbatim}
+     setelt : (%,List(Integer),List(Integer),%) -> %
+     setelt(x:%,rowList:List Integer,colList:List Integer,y:%) ==
+       for ei in rowList repeat
+         (ei < minr(x)) or (ei > maxr(x)) =>
+           error "setelt: index out of range"
+       for ej in colList repeat
+         (ej < minc(x)) or (ej > maxc(x)) =>
+           error "setelt: index out of range"
+       ((# rowList) ^= (nrows y)) or ((# colList) ^= (ncols y)) =>
+         error "setelt: matrix has bad dimensions"
+       for ei in rowList for i in minr(y)..maxr(y) repeat
+         for ej in colList for j in minc(y)..maxc(y) repeat
+           qsetelt_!(x,ei,ej,qelt(y,i,j))
+       y
 
-These exports come from \refto{AbelianMonoid}():
-\begin{verbatim}
- 0 : () -> %
- sample : () -> %
+     subMatrix: (%,Integer,Integer,Integer,Integer) -> %
+     subMatrix(x,i1,i2,j1,j2) ==
+       (i2 < i1) => error "subMatrix: bad row indices"
+       (j2 < j1) => error "subMatrix: bad column indices"
+       (i1 < minr(x)) or (i2 > maxr(x)) =>
+         error "subMatrix: index out of range"
+       (j1 < minc(x)) or (j2 > maxc(x)) =>
+         error "subMatrix: index out of range"
+       rows := (i2 - i1 + 1) pretend NonNegativeInteger
+       cols := (j2 - j1 + 1) pretend NonNegativeInteger
+       y := new(rows,cols,0)
+       for i in minr(y)..maxr(y) for k in i1..i2 repeat
+         for j in minc(y)..maxc(y) for l in j1..j2 repeat
+           qsetelt_!(y,i,j,qelt(x,k,l))
+       y
+
+     setsubMatrix_!: (%,Integer,Integer,%) -> %
+     setsubMatrix_!(x,i1,j1,y) ==
+       i2 := i1 + nrows(y) -1
+       j2 := j1 + ncols(y) -1
+       (i1 < minr(x)) or (i2 > maxr(x)) =>
+        error _
+         "setsubMatrix!: inserted matrix too big, use subMatrix to restrict it"
+       (j1 < minc(x)) or (j2 > maxc(x)) =>
+        error _
+         "setsubMatrix!: inserted matrix too big, use subMatrix to restrict it"
+       for i in minr(y)..maxr(y) for k in i1..i2 repeat
+         for j in minc(y)..maxc(y) for l in j1..j2 repeat
+           qsetelt_!(x,k,l,qelt(y,i,j))
+       x
+
+--% Arithmetic
+
+     "+": (%,%) -> %
+     x + y ==
+       ((r := nrows x) ^= nrows y) or ((c := ncols x) ^= ncols y) =>
+         error "can't add matrices of different dimensions"
+       ans := new(r,c,0)
+       for i in minr(x)..maxr(x) repeat
+         for j in minc(x)..maxc(x) repeat
+           qsetelt_!(ans,i,j,qelt(x,i,j) + qelt(y,i,j))
+       ans
+
+     "-": (%,%) -> %
+     x - y ==
+       ((r := nrows x) ^= nrows y) or ((c := ncols x) ^= ncols y) =>
+         error "can't subtract matrices of different dimensions"
+       ans := new(r,c,0)
+       for i in minr(x)..maxr(x) repeat
+         for j in minc(x)..maxc(x) repeat
+           qsetelt_!(ans,i,j,qelt(x,i,j) - qelt(y,i,j))
+       ans
+
+     "-":  %    -> %
+     - x == map((r1:R):R +-> - r1,x)
+
+     "*": (%,R) -> %
+     a:R * x:% == map((r1:R):R +-> a * r1,x)
+
+     "*": (R,%) -> %
+     x:% * a:R == map((r1:R):R +-> r1 * a,x)
+
+     "*": (Integer,%) -> %
+     m:Integer * x:% == map((r1:R):R +-> m * r1,x)
+
+     ?*? : (%,%) -> %
+     x:% * y:% ==
+       (ncols x ^= nrows y) =>
+         error "can't multiply matrices of incompatible dimensions"
+       ans := new(nrows x,ncols y,0)
+       for i in minr(x)..maxr(x) repeat
+         for j in minc(y)..maxc(y) repeat
+           entry :=
+             sum : R := 0
+             for k in minr(y)..maxr(y) for l in minc(x)..maxc(x) repeat
+               sum := sum + qelt(x,i,l) * qelt(y,k,j)
+             sum
+           qsetelt_!(ans,i,j,entry)
+       ans
+
+     positivePower:(%,Integer) -> %
+     positivePower(x,n) ==
+       (n = 1) => x
+       odd? n => x * positivePower(x,n - 1)
+       y := positivePower(x,n quo 2)
+       y * y
+
+     ?**? : (%,NonNegativeInteger) -> %
+     x:% ** n:NonNegativeInteger ==
+       not((nn:= nrows x) = ncols x) => error "**: matrix must be square"
+       zero? n => scalarMatrix(nn,1)
+       positivePower(x,n)
+
+     --if R has ConvertibleTo InputForm then
+       --convert(x:%):InputForm ==
+         --convert [convert("matrix"::Symbol)@InputForm,
+                  --convert listOfLists x]$List(InputForm)
+
+     if Col has shallowlyMutable then
+
+       "*": (%,Col) -> Col
+       x:% * v:Col ==
+         ncols(x) ^= #v =>
+           error "can't multiply matrix A and vector v if #cols A ^= #v"
+         w : Col := new(nrows x,0)
+         for i in minr(x)..maxr(x) for k in mini(w)..maxi(w) repeat
+           w.k :=
+             sum : R := 0
+             for j in minc(x)..maxc(x) for l in mini(v)..maxi(v) repeat
+               sum := sum + qelt(x,i,j) * v(l)
+             sum
+         w
+
+     if Row has shallowlyMutable then
+
+       "*": (Row,%) -> Row
+       v:Row * x:% ==
+         nrows(x) ^= #v =>
+           error "can't multiply vector v and matrix A if #rows A ^= #v"
+         w : Row := new(ncols x,0)
+         for j in minc(x)..maxc(x) for k in mini(w)..maxi(w) repeat
+           w.k :=
+             sum : R := 0
+             for i in minr(x)..maxr(x) for l in mini(v)..maxi(v) repeat
+               sum := sum + qelt(x,i,j) * v(l)
+             sum
+         w
+
+     if R has EuclideanDomain then
+
+       columnSpace: % -> List Col
+       columnSpace M ==
+         M2 := rowEchelon M
+         basis: List Col := []
+         n: Integer := ncols M
+         m: Integer := nrows M
+         indRow: Integer := 1
+         for k in 1..n while indRow <= m repeat
+           if not zero?(M2.(indRow,k)) then
+             basis := cons(column(M,k),basis)
+             indRow := indRow + 1
+         reverse! basis
+
+     if R has CommutativeRing then
+
+       skewSymmetricUnitMatrix(n:PositiveInteger):% ==
+         matrix [[(if i=j+1 and odd? j
+                    then -1
+                    else if i=j-1 and odd? i
+                           then 1
+                           else 0) for j in 1..n] for i in 1..n]
+
+       SUPR ==> SparseUnivariatePolynomial R
+  
+       PfChar(A:%):SUPR ==
+         n := nrows A
+         (n = 2) => monomial(1$R,2)$SUPR + qelt(A,1,2)::SUPR
+         M:=subMatrix(A,3,n,3,n)
+         r:=subMatrix(A,1,1,3,n)
+         s:=subMatrix(A,3,n,2,2)
+         p:=PfChar(M)
+         d:=degree(p)$SUPR
+         B:=skewSymmetricUnitMatrix((n-2)::PositiveInteger)
+         C:=r*B
+         g:List R := [qelt(C*s,1,1), qelt(A,1,2), 1]
+         if d >= 4 then
+           B:=M*B
+           for i in 4..d by 2 repeat
+             C:=C*B
+             g:=cons(qelt(C*s,1,1),g)
+         g:=reverse! g
+         res:SUPR := 0
+         for i in 0..d by 2 for j in 2..d+2 repeat
+           c:=coefficient(p,i)
+           for e in first(g,j) for k in 2..-d by -2 repeat
+             res:=res+monomial(c*e,(k+i)::NonNegativeInteger)$SUPR
+         res
+
+       pfaffian: % -> R
+       pfaffian a ==
+         if antisymmetric? a
+           then if odd? nrows a
+                  then 0
+                  else PfChar(a).0
+           else 
+             error "pfaffian: only defined for antisymmetric square matrices"
+
+     if R has IntegralDomain then
+
+       "exquo": (%,R) -> Union(%,"failed")
+       x exquo a ==
+         ans := new(nrows x,ncols x,0)
+         for i in minr(x)..maxr(x) repeat
+           for j in minc(x)..maxc(x) repeat
+             entry :=
+               (r := (qelt(x,i,j) exquo a)) case "failed" =>
+                 return "failed"
+               r :: R
+             qsetelt_!(ans,i,j,entry)
+         ans
+
+     if R has Field then
+
+       "/": (%,R) -> %
+       x / r == map((r1:R):R +-> r1 / r,x)
+
+       "**": (%,Integer) -> %
+       x:% ** n:Integer ==
+         not((nn:= nrows x) = ncols x) => error "**: matrix must be square"
+         zero? n => scalarMatrix(nn,1)
+         positive? n => positivePower(x,n)
+         (xInv := inverse x) case "failed" =>
+           error "**: matrix must be invertible"
+         positivePower(xInv :: %,-n)
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{MATCAT.dotabb}
+"MATCAT"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=MATCAT"];
+"MATCAT" -> "ARR2CAT"
+
+\end{chunk}
+
+\begin{chunk}{MATCAT.dotfull}
+"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" 
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=MATCAT"];
+"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)"
+ ->
+"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))"
+
+\end{chunk}
+
+\begin{chunk}{MATCAT.dotpic}
+digraph pic {
+ fontsize=10;
+ bgcolor="#ECEA81";
+ node [shape=box, color=white, style=filled];
+
+"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)" 
+ [color=lightblue];
+"MatrixCategory(a:Ring,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a)"
+ ->
+"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))"
+
+"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))"
+ [color=lightblue];
+"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))"
+    -> "HomogeneousAggregate(a:Type)"
+
+"HomogeneousAggregate(a:Type)" [color=lightblue];
+"HomogeneousAggregate(a:Type)" -> "Aggregate()"
+"HomogeneousAggregate(a:Type)" -> "Evalable(a:Type)"
+"HomogeneousAggregate(a:Type)" -> "SetCategory()"
+
+"Evalable(a:Type)" [color="#00EE00"];
+
+"SetCategory()" [color=lightblue];
+"SetCategory()" -> "BasicType()"
+"SetCategory()" -> "CoercibleTo(OutputForm)"
+
+"BasicType()" [color=lightblue];
+"BasicType()" -> "Category"
+
+"CoercibleTo(OutputForm)" [color=seagreen];
+"CoercibleTo(OutputForm)" -> "CoercibleTo(a:Type)"
+
+"CoercibleTo(a:Type)" [color=lightblue];
+"CoercibleTo(a:Type)" -> "Category"
+
+"Aggregate()" [color=lightblue];
+"Aggregate()" -> "Type()"
+
+"Type()" [color=lightblue];
+"Type()" -> "Category"
+
+"Category" [color=lightblue];
+
+}
+
+\end{chunk}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\pagehead{OrderedAbelianSemiGroup}{OASGP}
+\pagepic{ps/v102orderedabeliansemigroup.ps}{OASGP}{0.75}
+
+\begin{chunk}{OrderedAbelianSemiGroup.input}
+)set break resume
+)sys rm -f OrderedAbelianSemiGroup.output
+)spool OrderedAbelianSemiGroup.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show OrderedAbelianSemiGroup
+--R 
+--R OrderedAbelianSemiGroup  is a category constructor
+--R Abbreviation for OrderedAbelianSemiGroup is OASGP 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.2.pamphlet to see algebra source code for OASGP 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
+--R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
+--R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
+--R ?>=? : (%,%) -> Boolean               coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R max : (%,%) -> %                      min : (%,%) -> %
+--R ?~=? : (%,%) -> Boolean              
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+
+\begin{chunk}{OrderedAbelianSemiGroup.help}
+====================================================================
+OrderedAbelianSemiGroup examples
+====================================================================
+
+Ordered sets which are also abelian semigroups, such that the addition
+preserves the ordering.
+
+Axiom:
+        x < y => x+z < y+z
+
+See Also:
+o )show OrderedAbelianSemiGroup
+
+\end{chunk}
+{\bf See:}
+
+\pageto{OrderedAbelianMonoid}{OAMON}
+\pagefrom{AbelianMonoid}{ABELMON}
+\pagefrom{OrderedSet}{ORDSET}
+
+{\bf Exports:}\\
+
+\begin{tabular}{lllll}
+\cross{OASGP}{0} &
+\cross{OASGP}{coerce} &
+\cross{OASGP}{hash} &
+\cross{OASGP}{latex} &
+\cross{OASGP}{max} \\
+\cross{OASGP}{min} &
+\cross{OASGP}{sample} &
+\cross{OASGP}{zero?} &
+\cross{OASGP}{?\~{}=?} &
+\cross{OASGP}{?*?} \\
+\cross{OASGP}{?+?} &
+\cross{OASGP}{?$<$?} &
+\cross{OASGP}{?$<=$?} &
+\cross{OASGP}{?=?} &
+\cross{OASGP}{?$>$?} \\
+\cross{OASGP}{?$>=$?} &&&&
+\end{tabular}
+
+These exports come from \refto{OrderedSet}():
+\begin{verbatim}
+ coerce : % -> OutputForm              
+ hash : % -> SingleInteger
+ latex : % -> String                   
+ max : (%,%) -> %
+ min : (%,%) -> %                      
+ ?<? : (%,%) -> Boolean                
+ ?>? : (%,%) -> Boolean
+ ?<=? : (%,%) -> Boolean
+ ?>=? : (%,%) -> Boolean               
+ ?=? : (%,%) -> Boolean                
+ ?~=? : (%,%) -> Boolean
+\end{verbatim}
+
+These exports come from \refto{AbelianMonoid}():
+\begin{verbatim}
+ 0 : () -> %
+ sample : () -> %
  zero? : % -> Boolean                  
  ?*? : (NonNegativeInteger,%) -> %
  ?*? : (PositiveInteger,%) -> %        
@@ -21437,6 +23920,15 @@ These exports come from \refto{AbelianMonoid}():
 OrderedAbelianSemiGroup(): Category == Join(OrderedSet, AbelianSemiGroup)
 
 \end{chunk}
+
+\begin{chunk}{COQ OASGP}
+(* category OASGP *)
+(*
+Axiom
+   x < y => x+z < y+z
+*)
+\end{chunk}
+
 \begin{chunk}{OASGP.dotabb}
 "OASGP"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OASGP"];
@@ -21444,6 +23936,7 @@ OrderedAbelianSemiGroup(): Category == Join(OrderedSet, AbelianSemiGroup)
 "OASGP" -> "ABELMON"
 
 \end{chunk}
+
 \begin{chunk}{OASGP.dotfull}
 "OrderedAbelianSemiGroup()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OASGP"];
@@ -21451,6 +23944,7 @@ OrderedAbelianSemiGroup(): Category == Join(OrderedSet, AbelianSemiGroup)
 "OrderedAbelianSemiGroup()" -> "AbelianMonoid()"
 
 \end{chunk}
+
 \begin{chunk}{OASGP.dotpic}
 digraph pic {
  fontsize=10;
@@ -21497,6 +23991,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OrderedMonoid}{ORDMON}
 \pagepic{ps/v102orderedmonoid.ps}{ORDMON}{0.75}
@@ -21534,6 +24029,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OrderedMonoid.help}
 ====================================================================
 OrderedMonoid examples
@@ -21619,6 +24115,17 @@ These exports come from \refto{OrderedSet}():
 OrderedMonoid(): Category == Join(OrderedSet, Monoid)
 
 \end{chunk}
+
+\begin{chunk}{COQ ORDMON}
+(* category ORDMON *)
+(*
+Axioms:
+  x < y => x*z < y*z
+  x < y => z*x < z*y
+*)
+
+\end{chunk}
+
 \begin{chunk}{ORDMON.dotabb}
 "ORDMON"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDMON"];
@@ -21626,6 +24133,7 @@ OrderedMonoid(): Category == Join(OrderedSet, Monoid)
 "ORDMON" -> "MONOID"
 
 \end{chunk}
+
 \begin{chunk}{ORDMON.dotfull}
 "OrderedMonoid()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDMON"];
@@ -21633,6 +24141,7 @@ OrderedMonoid(): Category == Join(OrderedSet, Monoid)
 "OrderedMonoid()" -> "Monoid()"
 
 \end{chunk}
+
 \begin{chunk}{ORDMON.dotpic}
 digraph pic {
  fontsize=10;
@@ -21681,6 +24190,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PolynomialSetCategory}{PSETCAT}
 \pagepic{ps/v102polynomialsetcategory.ps}{PSETCAT}{0.30}
@@ -21756,6 +24266,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PolynomialSetCategory.help}
 ====================================================================
 PolynomialSetCategory examples
@@ -22218,7 +24729,6 @@ PolynomialSetCategory(R:Ring, E:OrderedAbelianMonoidSup,_
 
        makeIrreducible! (frac:Record(num:P,den:R)):Record(num:P,den:R) ==
          g := gcd(frac.den,frac.num)$P
---         one? g => frac
          (g = 1) => frac
          frac.num := exactQuotient!(frac.num,g)
          frac.den := exactQuo(frac.den,g)
@@ -22285,6 +24795,283 @@ PolynomialSetCategory(R:Ring, E:OrderedAbelianMonoidSup,_
          removeDuplicates rs
 
 \end{chunk}
+
+\begin{chunk}{COQ PSETCAT}
+(* category PSETCAT *)
+(*
+
+     NNI ==> NonNegativeInteger
+     B ==> Boolean
+
+     elements: $ -> List(P)
+     elements(ps:$):List(P) ==
+       lp : List(P) := members(ps)$$
+
+     variables1: (List(P)) -> (List VarSet)
+     variables1(lp:List(P)):(List VarSet) ==
+       lvars : List(List(VarSet)) := [variables(p)$P for p in lp]
+       sort((z1:VarSet,z2:VarSet):Boolean +-> z1 > z2, 
+             removeDuplicates(concat(lvars)$List(VarSet)))
+
+     variables2: (List(P)) -> (List VarSet)
+     variables2(lp:List(P)):(List VarSet) ==
+       lvars : List(VarSet) := [mvar(p)$P for p in lp]
+       sort((z1:VarSet,z2:VarSet):Boolean +-> z1 > z2, 
+             removeDuplicates(lvars)$List(VarSet))
+
+     variables : $ -> List VarSet
+     variables (ps:$) ==
+       variables1(elements(ps))
+
+     mainVariables : $  -> List VarSet
+     mainVariables (ps:$) ==
+       variables2(remove(ground?,elements(ps)))
+
+     mainVariable? : (VarSet,$) -> Boolean
+     mainVariable? (v,ps) ==
+       lp : List(P) := remove(ground?,elements(ps))
+       while (not empty? lp) and (not (mvar(first(lp)) = v)) repeat
+         lp := rest lp
+       (not empty? lp)
+
+     collectUnder : ($,VarSet) -> $
+     collectUnder (ps,v) ==
+       lp : List P := elements(ps)
+       lq : List P := []
+       while (not empty? lp) repeat
+         p := first lp
+         lp := rest lp
+         if (ground?(p)) or (mvar(p) < v)
+           then
+             lq := cons(p,lq)
+       construct(lq)$$
+
+     collectUpper : ($,VarSet) -> $
+     collectUpper (ps,v) ==
+       lp : List P := elements(ps)
+       lq : List P := []
+       while (not empty? lp) repeat
+         p := first lp
+         lp := rest lp
+         if (not ground?(p)) and (mvar(p) > v)
+           then
+             lq := cons(p,lq)
+       construct(lq)$$
+
+     collect : ($,VarSet) -> $
+     collect (ps,v) ==
+       lp : List P := elements(ps)
+       lq : List P := []
+       while (not empty? lp) repeat
+         p := first lp
+         lp := rest lp
+         if (not ground?(p)) and (mvar(p) = v)
+           then
+             lq := cons(p,lq)
+       construct(lq)$$
+
+     sort : ($,VarSet) -> Record(under:$,floor:$,upper:$)
+     sort (ps,v) ==
+       lp : List P := elements(ps)
+       us : List P := []
+       vs : List P := []
+       ws : List P := []
+       while (not empty? lp) repeat
+         p := first lp
+         lp := rest lp
+         if (ground?(p)) or (mvar(p) < v)
+           then
+             us := cons(p,us)
+           else
+             if (mvar(p) = v)
+               then
+                 vs := cons(p,vs)
+               else
+                 ws := cons(p,ws)
+       [construct(us)$$,_
+        construct(vs)$$,_
+        construct(ws)$$]$Record(under:$,floor:$,upper:$)
+
+     ?=? : (%,%) -> Boolean
+     ps1 = ps2 ==
+       {p for p in elements(ps1)} =$(Set P) {p for p in elements(ps2)}
+
+     localInf? (p:P,q:P):B ==
+       degree(p) <$E degree(q)
+
+     localTriangular? (lp:List(P)):B ==
+       lp := remove(zero?, lp)
+       empty? lp => true
+       any? (ground?, lp) => false
+       lp := sort((z1:P,z2:P):Boolean +-> mvar(z1)$P > mvar(z2)$P, lp)
+       p,q : P
+       p := first lp
+       lp := rest lp
+       while (not empty? lp) and (mvar(p) > mvar((q := first(lp)))) repeat
+         p := q
+         lp := rest lp
+       empty? lp
+
+     triangular? : $ -> Boolean
+     triangular? ps ==
+       localTriangular? elements ps
+
+     trivialIdeal?: $ -> Boolean
+     trivialIdeal? ps ==
+       empty?(remove(zero?,elements(ps))$(List(P)))$(List(P))
+
+     if R has IntegralDomain
+     then
+
+       roughUnitIdeal? : $ -> Boolean
+       roughUnitIdeal? ps ==
+         any?(ground?,remove(zero?,elements(ps))$(List(P)))$(List P)
+
+       relativelyPrimeLeadingMonomials? (p:P,q:P):B ==
+         dp : E := degree(p)
+         dq : E := degree(q)
+         (sup(dp,dq)$E =$E dp +$E dq)@B
+
+       roughBase? : $ -> Boolean
+       roughBase? ps ==
+         lp := remove(zero?,elements(ps))$(List(P))
+         empty? lp => true
+         rB? : B := true
+         while (not empty? lp) and rB? repeat
+           p := first lp
+           lp := rest lp
+           copylp := lp
+           while (not empty? copylp) and rB? repeat
+             rB? := relativelyPrimeLeadingMonomials?(p,first(copylp))
+             copylp := rest copylp
+         rB?
+
+       roughSubIdeal?  : ($,$) -> Boolean
+       roughSubIdeal?(ps1,ps2) ==
+         lp: List(P) := rewriteIdealWithRemainder(elements(ps1),ps2)
+         empty? (remove(zero?,lp))
+
+       roughEqualIdeals? : ($,$) -> Boolean
+       roughEqualIdeals? (ps1,ps2) ==
+         ps1 =$$ ps2 => true
+         roughSubIdeal?(ps1,ps2) and roughSubIdeal?(ps2,ps1)
+
+     if (R has GcdDomain) and (VarSet has ConvertibleTo (Symbol))
+     then
+
+       LPR ==> List Polynomial R
+       LS ==> List Symbol
+
+       if R has EuclideanDomain
+         then
+
+           exactQuo : (R,R) -> R
+           exactQuo(r:R,s:R):R ==
+             r quo$R s
+
+         else
+
+           exactQuo : (R,R) -> R
+           exactQuo(r:R,s:R):R ==
+             (r exquo$R s)::R
+
+       headRemainder : (P,$) -> Record(num:P,den:R)
+       headRemainder (a,ps) ==
+         lp1 : List(P) := remove(zero?, elements(ps))$(List(P))
+         empty? lp1 => [a,1$R]
+         any?(ground?,lp1) => [reductum(a),1$R]
+         r : R := 1$R
+         lp1 := sort(localInf?, reverse elements(ps))
+         lp2 := lp1
+         e : Union(E, "failed")
+         while (not zero? a) and (not empty? lp2) repeat
+           p := first lp2
+           if ((e:= subtractIfCan(degree(a),degree(p))) case E)
+             then
+               g := gcd((lca := leadingCoefficient(a)),_
+                        (lcp := leadingCoefficient(p)))$R
+               (lca,lcp) := (exactQuo(lca,g),exactQuo(lcp,g))
+               a := lcp * reductum(a) - monomial(lca, e::E)$P * reductum(p)
+               r := r * lcp
+               lp2 := lp1
+             else
+               lp2 := rest lp2
+         [a,r]
+
+       makeIrreducible! (frac:Record(num:P,den:R)):Record(num:P,den:R) ==
+         g := gcd(frac.den,frac.num)$P
+         (g = 1) => frac
+         frac.num := exactQuotient!(frac.num,g)
+         frac.den := exactQuo(frac.den,g)
+         frac
+
+       remainder : (P,$) -> Record(rnum:R,polnum:P,den:R)
+       remainder (a,ps) ==
+         hRa := makeIrreducible! headRemainder (a,ps)
+         a := hRa.num
+         r : R := hRa.den
+         zero? a => [1$R,a,r]
+         b : P := monomial(1$R,degree(a))$P
+         c : R := leadingCoefficient(a)
+         while not zero?(a := reductum a) repeat
+           hRa := makeIrreducible!  headRemainder (a,ps)
+           a := hRa.num
+           r := r * hRa.den
+           g := gcd(c,(lca := leadingCoefficient(a)))$R
+           b := ((hRa.den) * exactQuo(c,g)) * b + _
+                 monomial(exactQuo(lca,g),degree(a))$P
+           c := g
+         [c,b,r]
+
+       rewriteIdealWithHeadRemainder : (List(P),%) -> List(P) if R has INTDOM
+       rewriteIdealWithHeadRemainder(ps,cs) ==
+         trivialIdeal? cs => ps
+         roughUnitIdeal? cs => [0$P]
+         ps := remove(zero?,ps)
+         empty? ps => ps
+         any?(ground?,ps) => [1$P]
+         rs : List P := []
+         while not empty? ps repeat
+           p := first ps
+           ps := rest ps
+           p := (headRemainder(p,cs)).num
+           if not zero? p
+             then 
+               if ground? p
+                 then
+                   ps := []
+                   rs := [1$P]
+                 else
+                   primitivePart! p
+                   rs := cons(p,rs)
+         removeDuplicates rs
+
+       rewriteIdealWithRemainder : (List(P),%) -> List(P) if R has INTDOM
+       rewriteIdealWithRemainder(ps,cs) ==
+         trivialIdeal? cs => ps
+         roughUnitIdeal? cs => [0$P]
+         ps := remove(zero?,ps)
+         empty? ps => ps
+         any?(ground?,ps) => [1$P]
+         rs : List P := []
+         while not empty? ps repeat
+           p := first ps
+           ps := rest ps
+           p := (remainder(p,cs)).polnum
+           if not zero? p
+             then 
+               if ground? p
+                 then
+                   ps := []
+                   rs := [1$P]
+                 else
+                   rs := cons(unitCanonical(p),rs)
+         removeDuplicates rs
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{PSETCAT.dotabb}
 "PSETCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PSETCAT"];
@@ -22293,6 +25080,7 @@ PolynomialSetCategory(R:Ring, E:OrderedAbelianMonoidSup,_
 "PSETCAT" -> "SETCAT"
 
 \end{chunk}
+
 \begin{chunk}{PSETCAT.dotfull}
 "PolynomialSetCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PSETCAT"];
@@ -22309,6 +25097,7 @@ PolynomialSetCategory(R:Ring, E:OrderedAbelianMonoidSup,_
   -> "PolynomialSetCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))"
 
 \end{chunk}
+
 \begin{chunk}{PSETCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -22369,6 +25158,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PriorityQueueAggregate}{PRQAGG}
 \pagepic{ps/v102priorityqueueaggregate.ps}{PRQAGG}{1.00}
@@ -22423,6 +25213,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PriorityQueueAggregate.help}
 ====================================================================
 PriorityQueueAggregate examples
@@ -22556,12 +25347,14 @@ PriorityQueueAggregate(S:OrderedSet): Category == BagAggregate S with
      ++ values from priority queue q1.
 
 \end{chunk}
+
 \begin{chunk}{PRQAGG.dotabb}
 "PRQAGG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PRQAGG"];
 "PRQAGG" -> "BGAGG"
 
 \end{chunk}
+
 \begin{chunk}{PRQAGG.dotfull}
 "PriorityQueueAggregate(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PRQAGG"];
@@ -22577,6 +25370,7 @@ PriorityQueueAggregate(S:OrderedSet): Category == BagAggregate S with
    "PriorityQueueAggregate(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{PRQAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -22602,6 +25396,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{QueueAggregate}{QUAGG}
 \pagepic{ps/v102queueaggregate.ps}{QUAGG}{1.00}
@@ -22658,6 +25453,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{QueueAggregate.help}
 ====================================================================
 QueueAggregate examples
@@ -22809,11 +25605,13 @@ QueueAggregate(S:Type): Category == BagAggregate S with
      ++ Error: if q is empty.
 
 \end{chunk}
+
 \begin{chunk}{QUAGG.dotabb}
 "QUAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=QUAGG"];
 "QUAGG" -> "BGAGG"
 
 \end{chunk}
+
 \begin{chunk}{QUAGG.dotfull}
 "QueueAggregate(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=QUAGG"];
@@ -22824,6 +25622,7 @@ QueueAggregate(S:Type): Category == BagAggregate S with
 "QueueAggregate(a:SetCategory)" -> "QueueAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{QUAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -22914,6 +25713,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{SetAggregate.help}
 ====================================================================
 SetAggregate examples
@@ -23152,6 +25952,27 @@ SetAggregate(S:SetCategory):
   difference(s:%, x:S) == difference(s, {x})
 
 \end{chunk}
+
+\begin{chunk}{COQ SETAGG}
+(* category SETAGG *)
+(*
+
+  symmetricDifference : (%, %) -> %
+  symmetricDifference(x, y)    == union(difference(x, y), difference(y, x))
+
+  union : (%, S) -> %
+  union(s:%, x:S) == union(s, {x})
+
+  union : (S, %) -> %
+  union(x:S, s:%) == union(s, {x})
+
+  difference : (%, S) -> %
+  difference(s:%, x:S) == difference(s, {x})
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{SETAGG.dotabb}
 "SETAGG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SETAGG"];
@@ -23159,6 +25980,7 @@ SetAggregate(S:SetCategory):
 "SETAGG" -> "CLAGG"
 
 \end{chunk}
+
 \begin{chunk}{SETAGG.dotfull}
 "SetAggregate(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SETAGG"];
@@ -23166,6 +25988,7 @@ SetAggregate(S:SetCategory):
 "SetAggregate(a:SetCategory)" -> "Collection(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{SETAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -23209,6 +26032,7 @@ digraph pic {
 
 }
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{StackAggregate}{SKAGG}
 \pagepic{ps/v102stackaggregate.ps}{SKAGG}{1.00}
@@ -23264,6 +26088,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{StackAggregate.help}
 ====================================================================
 StackAggregate examples
@@ -23421,11 +26246,13 @@ StackAggregate(S:Type): Category == BagAggregate S with
      ++X a:Stack INT:= stack [1,2,3,4,5]
      ++X depth a
 \end{chunk}
+
 \begin{chunk}{SKAGG.dotabb}
 "SKAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=SKAGG"];
 "SKAGG" -> "BGAGG"
 
 \end{chunk}
+
 \begin{chunk}{SKAGG.dotfull}
 "StackAggregate(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SKAGG"];
@@ -23436,6 +26263,7 @@ StackAggregate(S:Type): Category == BagAggregate S with
 "StackAggregate(a:SetCategory)" -> "StackAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{SKAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -23461,6 +26289,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{UnaryRecursiveAggregate}{URAGG}
 \pagepic{ps/v102unaryrecursiveaggregate.ps}{URAGG}{1.00}
@@ -23540,6 +26369,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{UnaryRecursiveAggregate.help}
 ====================================================================
 UnaryRecursiveAggregate examples
@@ -23985,17 +26815,222 @@ UnaryRecursiveAggregate(S:Type): Category == RecursiveAggregate S with
       y
 
 \end{chunk}
+
+\begin{chunk}{COQ URAGG}
+(* category URAGG *)
+(*
+  cycleMax ==> 1000
+
+  elt: (%,"first") -> S
+  elt(x, "first") == first x
+
+  elt: (%,"last") -> S
+  elt(x,  "last") == last x
+
+  elt: (%,"rest") -> %
+  elt(x,  "rest") == rest x
+
+  second: % -> S
+  second x == first rest x
+
+  third: % -> S
+  third x == first rest rest x
+
+  cyclic? : % -> Boolean
+  cyclic? x == not empty? x and not empty? findCycle x
+
+  last: % -> S
+  last x == first tail x
+
+  nodes : % -> List(%)
+  nodes x ==
+    l := empty()$List(%)
+    while not empty? x repeat
+      l := concat(x, l)
+      x := rest x
+    reverse_! l
+
+  children : % -> List(%)
+  children x ==
+    l := empty()$List(%)
+    empty? x => l
+    concat(rest x,l)
+
+  leaf? : % -> Boolean
+  leaf? x == empty? x
+
+  value : % -> S
+  value x ==
+    empty? x => error "value of empty object"
+    first x
+
+  less? : (%,NonNegativeInteger) -> Boolean
+  less?(l, n) ==
+    i := n::Integer
+    while i > 0 and not empty? l repeat (l := rest l; i := i - 1)
+    i > 0
+
+  more? : (%,NonNegativeInteger) -> Boolean
+  more?(l, n) ==
+    i := n::Integer
+    while i > 0 and not empty? l repeat (l := rest l; i := i - 1)
+    zero?(i) and not empty? l
+
+  size? : (%,NonNegativeInteger) -> Boolean
+  size?(l, n) ==
+    i := n::Integer
+    while not empty? l and i > 0 repeat (l := rest l; i := i - 1)
+    empty? l and zero? i
+
+  #? : % -> NonNegativeInteger
+  #x ==
+    for k in 0.. while not empty? x repeat
+      k = cycleMax and cyclic? x => error "cyclic list"
+      x := rest x
+    k
+
+  tail: % -> %
+  tail x ==
+    empty? x => error "empty list"
+    y := rest x
+    for k in 0.. while not empty? y repeat
+      k = cycleMax and cyclic? x => error "cyclic list"
+      y := rest(x := y)
+    x
+
+  findCycle: % -> %
+  findCycle x ==
+    y := rest x
+    while not empty? y repeat
+      if eq?(x, y) then return x
+      x := rest x
+      y := rest y
+      if empty? y then return y
+      if eq?(x, y) then return y
+      y := rest y
+    y
+
+  cycleTail: % -> %
+  cycleTail x ==
+    empty?(y := x := cycleEntry x) => x
+    z := rest x
+    while not eq?(x,z) repeat (y := z; z := rest z)
+    y
+
+  cycleEntry: % -> %
+  cycleEntry x ==
+    empty? x => x
+    empty?(y := findCycle x) => y
+    z := rest y
+    for l in 1.. while not eq?(y,z) repeat z := rest z
+    y := x
+    for k in 1..l repeat y := rest y
+    while not eq?(x,y) repeat (x := rest x; y := rest y)
+    x
+
+  cycleLength: % -> NonNegativeInteger
+  cycleLength x ==
+    empty? x => 0
+    empty?(x := findCycle x) => 0
+    y := rest x
+    for k in 1.. while not eq?(x,y) repeat y := rest y
+    k
+
+  rest: (%,NonNegativeInteger) -> %
+  rest(x, n) ==
+    for i in 1..n repeat
+      empty? x => error "Index out of range"
+      x := rest x
+    x
+
+  if % has finiteAggregate then
+
+    last: (%,NonNegativeInteger) -> %
+    last(x, n) ==
+      n > (m := #x) => error "index out of range"
+      copy rest(x, (m - n)::NonNegativeInteger)
+
+  if S has SetCategory then
+
+    ?=? : (%,%) -> Boolean
+    x = y ==
+      eq?(x, y) => true
+      for k in 0.. while not empty? x and not empty? y repeat
+        k = cycleMax and cyclic? x => error "cyclic list"
+        first x ^= first y => return false
+        x := rest x
+        y := rest y
+      empty? x and empty? y
+
+    node? : (%,%) -> Boolean
+    node?(u, v) ==
+      for k in 0.. while not empty? v repeat
+        u = v => return true
+        k = cycleMax and cyclic? v => error "cyclic list"
+        v := rest v
+      u=v
+
+  if % has shallowlyMutable then
+
+    setelt: (%,"first",S) -> S
+    setelt(x, "first", a) == setfirst_!(x, a)
+
+    setelt: (%,"last",S) -> S
+    setelt(x,  "last", a) == setlast_!(x, a)
+
+    setelt: (%,"rest",%) -> %
+    setelt(x,  "rest", a) == setrest_!(x, a)
+
+    concat : (%,%) -> %
+    concat(x:%, y:%) == concat_!(copy x, y)
+
+    setlast_!: (%,S) -> S
+    setlast_!(x, s) ==
+      empty? x => error "setlast: empty list"
+      setfirst_!(tail x, s)
+      s
+
+    setchildren! : (%,List(%)) -> %
+    setchildren_!(u,lv) ==
+      #lv=1 => setrest_!(u, first lv)
+      error "wrong number of children specified"
+
+    setvalue! : (%,S) -> S
+    setvalue_!(u,s) == setfirst_!(u,s)
+
+    split_!: (%,Integer) -> %
+    split_!(p, n) ==
+      n < 1 => error "index out of range"
+      p := rest(p, (n - 1)::NonNegativeInteger)
+      q := rest p
+      setrest_!(p, empty())
+      q
+
+    cycleSplit_!: % -> %
+    cycleSplit_! x ==
+      empty?(y := cycleEntry x) or eq?(x, y) => y
+      z := rest x
+      while not eq?(z, y) repeat (x := z; z := rest z)
+      setrest_!(x, empty())
+      y
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{URAGG.dotabb}
 "URAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=URAGG"];
 "URAGG" -> "RCAGG"
 
 \end{chunk}
+
 \begin{chunk}{URAGG.dotfull}
 "UnaryRecursiveAggregate(a:Type)" 
  [color=lightblue,href="bookvol10.2.pdf#nameddest=URAGG"];
 "UnaryRecursiveAggregate(a:Type)" -> "RecursiveAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{URAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -24021,6 +27056,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 6}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{AbelianGroup}{ABELGRP}
@@ -24057,6 +27093,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{AbelianGroup.help}
 ====================================================================
 AbelianGroup examples
@@ -24161,12 +27198,43 @@ AbelianGroup(): Category == CancellationAbelianMonoid with
           double((-n) pretend PositiveInteger,-x)
 
 \end{chunk}
+
+\begin{chunk}{COQ ABELGRP}
+(* category ABELGRP *)
+(*
+Axioms
+ -(-x) = x
+ x+(-x) = 0
+
+      "-": (%,%) -> %                  
+      (x:% - y:%):% == x+(-y)
+
+      subtractIfCan : (%,%) -> Union(%,"failed")
+      subtractIfCan(x:%, y:%):Union(%, "failed") == (x-y)::Union(%,"failed")
+
+      ?*? : (NonNegativeInteger,%) -> %
+      n:NonNegativeInteger * x:% == (n::Integer) * x
+
+      import RepeatedDoubling(%)
+
+      if not (% has Ring) then
+
+        "*": (Integer,%) -> %            
+        n:Integer * x:% ==
+          zero? n => 0
+          n>0 => double(n pretend PositiveInteger,x)
+          double((-n) pretend PositiveInteger,-x)
+*)
+
+\end{chunk}
+
 \begin{chunk}{ABELGRP.dotabb}
 "ABELGRP"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ABELGRP"];
 "ABELGRP" -> "CABMON"
 
 \end{chunk}
+
 \begin{chunk}{ABELGRP.dotfull}
 "AbelianGroup()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ABELGRP"];
@@ -24174,6 +27242,7 @@ AbelianGroup(): Category == CancellationAbelianMonoid with
 "AbelianGroup()" -> "RepeatedDoubling(AbelianGroup)"
 
 \end{chunk}
+
 \begin{chunk}{ABELGRP.dotpic}
 digraph pic {
  fontsize=10;
@@ -24209,6 +27278,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{BinaryTreeCategory}{BTCAT}
 \pagepic{ps/v102binarytreecategory.ps}{BTCAT}{1.00}
@@ -24275,6 +27345,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{BinaryTreeCategory.help}
 ====================================================================
 BinaryTreeCategory examples
@@ -24457,12 +27528,49 @@ BinaryTreeCategory(S: SetCategory): Category == _
          treeCount(right t,k)
 
 \end{chunk}
+
+\begin{chunk}{COQ BTCAT}
+(* category BTCAT *)
+(*
+     cycleTreeMax ==> 5
+
+     copy : % -> %
+     copy t ==
+       empty? t => empty()
+       node(copy left t, value t, copy right t)
+
+     if % has shallowlyMutable then
+
+       map! : ((S -> S),%) -> %
+       map_!(f,t) ==
+         empty? t => t
+         t.value := f(t.value)
+         map_!(f,left t)
+         map_!(f,right t)
+         t
+
+     #? : % -> NonNegativeInteger
+     #t == treeCount(t,0)
+
+     treeCount : (%, NonNegativeInteger) -> NonNegativeInteger
+     treeCount(t,k) ==
+         empty? t => k
+         k := k + 1
+         k = cycleTreeMax and cyclic? t => error "cyclic binary tree"
+         k := treeCount(left t,k)
+         treeCount(right t,k)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{BTCAT.dotabb}
 "BTCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=BTCAT"];
 "BTCAT" -> "BRAGG"
 
 \end{chunk}
+
 \begin{chunk}{BTCAT.dotfull}
 "BinaryTreeCategory(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=BTCAT"];
@@ -24470,6 +27578,7 @@ BinaryTreeCategory(S: SetCategory): Category == _
    "BinaryRecursiveAggregate(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{BTCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -24504,6 +27613,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Dictionary}{DIAGG}
 \pagepic{ps/v102dictionary.ps}{DIAGG}{1.00}
@@ -24570,6 +27680,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Dictionary.help}
 ====================================================================
 Dictionary examples
@@ -24752,11 +27863,52 @@ Dictionary(S:SetCategory): Category ==
        t
 
 \end{chunk}
+
+\begin{chunk}{COQ DIAGG}
+(* category DIAGG *)
+(*
+
+   dictionary : List(S) -> %
+   dictionary l ==
+     d := dictionary()
+     for x in l repeat insert_!(x, d)
+     d
+
+   if % has finiteAggregate then
+
+    -- remove(f:S->Boolean,t:%)  == remove_!(f, copy t)
+
+    -- select(f, t)           == select_!(f, copy t)
+
+     select! : ((S -> Boolean),%) -> %
+     select_!(f, t)         == remove_!((x:S):Boolean +-> not f(x), t)
+
+     --extract_! d ==
+     --         empty? d => error "empty dictionary"
+     --         remove_!(x := first parts d, d, 1)
+     --         x
+
+     ?=? : (%,%) -> Boolean
+     s = t ==
+       eq?(s,t) => true
+       #s ^= #t => false
+       _and/[member?(x, t) for x in parts s]
+
+     remove! : ((S -> Boolean),%) -> %
+     remove_!(f:S->Boolean, t:%) ==
+       for m in parts t repeat if f m then remove_!(m, t)
+       t
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{DIAGG.dotabb}
 "DIAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIAGG"];
 "DIAGG" -> "DIOPS"
 
 \end{chunk}
+
 \begin{chunk}{DIAGG.dotfull}
 "Dictionary(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DIAGG"];
@@ -24768,6 +27920,7 @@ Dictionary(S:SetCategory): Category ==
     "Dictionary(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{DIAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -24806,6 +27959,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{DequeueAggregate}{DQAGG}
 \pagepic{ps/v102dequeueaggregate.ps}{DQAGG}{1.00}
@@ -24869,6 +28023,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{DequeueAggregate.help}
 ====================================================================
 DequeueAggregate examples
@@ -25065,12 +28220,14 @@ DequeueAggregate(S:Type):
      ++ the top (front) element is now the bottom (back) element, and so on.
 
 \end{chunk}
+
 \begin{chunk}{DQAGG.dotabb}
 "DQAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=DQAGG"];
 "DQAGG" -> "SKAGG"
 "DQAGG" -> "QUAGG"
 
 \end{chunk}
+
 \begin{chunk}{DQAGG.dotfull}
 "DequeueAggregate(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DQAGG"];
@@ -25082,6 +28239,7 @@ DequeueAggregate(S:Type):
 "DequeueAggregate(a:SetCategory)" -> "DequeueAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{DQAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -25108,6 +28266,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ExtensibleLinearAggregate}{ELAGG}
 \pagepic{ps/v102extensiblelinearaggregate.ps}{ELAGG}{0.90}
@@ -25195,6 +28354,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ExtensibleLinearAggregate.help}
 ====================================================================
 ExtensibleLinearAggregate examples
@@ -25459,17 +28619,71 @@ ExtensibleLinearAggregate(S:Type):Category == LinearAggregate S with
      merge_!(x, y) == merge_!(_<$S, x, y)
 
 \end{chunk}
+
+\begin{chunk}{COQ ELAGG}
+(* category ELAGG *)
+(*
+
+   delete : (%,Integer) -> %
+   delete(x:%, i:Integer) == delete_!(copy x, i)
+
+   delete : (%,UniversalSegment(Integer)) -> %
+   delete(x:%, i:UniversalSegment(Integer)) == delete_!(copy x, i)
+
+   remove : ((S -> Boolean),%) -> %
+   remove(f:S -> Boolean, x:%) == remove_!(f, copy x)
+
+   insert : (S,%,Integer) -> %
+   insert(s:S, x:%, i:Integer) == insert_!(s, copy x, i)
+
+   insert : (%,%,Integer) -> %
+   insert(w:%, x:%, i:Integer) == insert_!(copy w, copy x, i)
+
+   select : ((S -> Boolean),%) -> %
+   select(f, x) == select_!(f, copy x)
+
+   concat : (%,%) -> %
+   concat(x:%, y:%) == concat_!(copy x, y)
+
+   concat : (%,S) -> %
+   concat(x:%, y:S) == concat_!(copy x, new(1, y))
+
+   concat_!: (%,S) -> %
+   concat_!(x:%, y:S) == concat_!(x, new(1, y))
+
+   if S has SetCategory then
+
+     remove : (S,%) -> %
+     remove(s:S, x:%) == remove_!(s, copy x)
+
+     remove_!: (S->Boolean,%) -> %
+     remove_!(s:S, x:%) == remove_!(y +-> y = s, x)
+
+     removeDuplicates : % -> %
+     removeDuplicates(x:%) == removeDuplicates_!(copy x)
+
+   if S has OrderedSet then
+
+     merge! : (%,%) -> %
+     merge_!(x, y) == merge_!(_<$S, x, y)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ELAGG.dotabb}
 "ELAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=ELAGG"];
 "ELAGG" -> "LNAGG"
 
 \end{chunk}
+
 \begin{chunk}{ELAGG.dotfull}
 "ExtensibleLinearAggregate(a:Type)" 
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ELAGG"];
 "ExtensibleLinearAggregate(a:Type)" -> "LinearAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{ELAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -25500,6 +28714,7 @@ digraph pic {
 "..." [color=lightblue];
 }
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FiniteLinearAggregate}{FLAGG}
 \pagepic{ps/v102finitelinearaggregate.ps}{FLAGG}{0.90}
@@ -25596,6 +28811,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FiniteLinearAggregate.help}
 ====================================================================
 FiniteLinearAggregate examples
@@ -25903,17 +29119,56 @@ FiniteLinearAggregate(S:Type): Category == LinearAggregate S with
         sort_! l == sort_!(_<$S, l)
 
 \end{chunk}
+
+\begin{chunk}{COQ FLAGG}
+(* category FLAGG *)
+(*
+    if S has SetCategory then
+
+      position: (S, %) -> Integer
+      position(x:S, t:%) == position(x, t, minIndex t)
+
+    if S has OrderedSet then
+
+      sorted?: % -> Boolean
+      sorted? l          == sorted?((x,y) +-> x < y or x = y, l)
+
+      merge: (%,%) -> %
+      merge(x, y) == merge(_<$S, x, y)
+
+      sort: % -> %
+      sort l          == sort(_<$S, l)
+
+    if % has shallowlyMutable then
+
+      reverse: % -> %
+      reverse x         == reverse_! copy x
+
+      sort: ((S,S)->Boolean,%) -> %
+      sort(f, l) == sort_!(f, copy l)
+
+      if S has OrderedSet then
+
+        sort_!: % -> %
+        sort_! l == sort_!(_<$S, l)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FLAGG.dotabb}
 "FLAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=FLAGG"];
 "FLAGG" -> "LNAGG"
 
 \end{chunk}
+
 \begin{chunk}{FLAGG.dotfull}
 "FiniteLinearAggregate(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FLAGG"];
 "FiniteLinearAggregate(a:Type)" -> "LinearAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{FLAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -25948,6 +29203,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FreeAbelianMonoidCategory}{FAMONC}
 \pagepic{ps/v102freeabelianmonoidcategory.ps}{FAMONC}{0.50}
@@ -25990,6 +29246,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FreeAbelianMonoidCategory.help}
 ====================================================================
 FreeAbelianMonoidCategory examples
@@ -26115,6 +29372,7 @@ FreeAbelianMonoidCategory(S: SetCategory, E:CancellationAbelianMonoid): _
             ++ of \spad{{a1,...,an}} and \spad{{b1,...,bm}}.
 
 \end{chunk}
+
 \begin{chunk}{FAMONC.dotabb}
 "FAMONC"
   [color=lightblue,href="bookvol10.2.pdf#nameddest=FAMONC"];
@@ -26122,6 +29380,7 @@ FreeAbelianMonoidCategory(S: SetCategory, E:CancellationAbelianMonoid): _
 "FAMONC" -> "RETRACT"
 
 \end{chunk}
+
 \begin{chunk}{FAMONC.dotfull}
 "FreeAbelianMonoidCategory(a:SetCategory,b:CancellationAbelianMonoid)"
   [color=lightblue,href="bookvol10.2.pdf#nameddest=FAMONC"];
@@ -26131,6 +29390,7 @@ FreeAbelianMonoidCategory(S: SetCategory, E:CancellationAbelianMonoid): _
    "RetractableTo(SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{FAMONC.dotpic}
 digraph pic {
  fontsize=10;
@@ -26186,6 +29446,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{MultiDictionary}{MDAGG}
 \pagepic{ps/v102multidictionary.ps}{MDAGG}{0.90}
@@ -26255,6 +29516,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{MultiDictionary.help}
 ====================================================================
 MultiDictionary examples
@@ -26422,17 +29684,20 @@ MultiDictionary(S:SetCategory): Category == DictionaryOperations S with
 -- to become duplicates: % -> Iterator(D,D)
 
 \end{chunk}
+
 \begin{chunk}{MDAGG.dotabb}
 "MDAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=MDAGG"];
 "MDAGG" -> "DIOPS"
 
 \end{chunk}
+
 \begin{chunk}{MDAGG.dotfull}
 "MultiDictionary(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MDAGG"];
 "MultiDictionary(a:SetCategory)" -> "DictionaryOperations(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{MDAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -26465,6 +29730,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OrderedAbelianMonoid}{OAMON}
 \pagepic{ps/v102orderedabelianmonoid.ps}{OAMON}{1.00}
@@ -26501,6 +29767,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OrderedAbelianMonoid.help}
 ====================================================================
 OrderedAbelianMonoid examples
@@ -26575,12 +29842,14 @@ OrderedAbelianMonoid(): Category ==
         Join(OrderedAbelianSemiGroup, AbelianMonoid)
 
 \end{chunk}
+
 \begin{chunk}{OAMON.dotabb}
 "OAMON" [color=lightblue,href="bookvol10.2.pdf#nameddest=OAMON"];
 "OAMON" -> "OASGP"
 "OAMON" -> "ABELMON"
 
 \end{chunk}
+
 \begin{chunk}{OAMON.dotfull}
 "OrderedAbelianMonoid()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OAMON"];
@@ -26588,6 +29857,7 @@ OrderedAbelianMonoid(): Category ==
 "OrderedAbelianMonoid()" -> "AbelianMonoid()"
 
 \end{chunk}
+
 \begin{chunk}{OAMON.dotpic}
 digraph pic {
  fontsize=10;
@@ -26613,6 +29883,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PermutationCategory}{PERMCAT}
 \pagepic{ps/v102permutationcategory.ps}{PERMCAT}{0.65}
@@ -26658,6 +29929,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PermutationCategory.help}
 ====================================================================
 PermutationCategory examples
@@ -26805,18 +30077,21 @@ PermutationCategory(S:SetCategory): Category  ==  Group with
     if S has Finite then OrderedSet
 
 \end{chunk}
+
 \begin{chunk}{PERMCAT.dotabb}
 "PERMCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PERMCAT"];
 "PERMCAT" -> "GROUP"
 
 \end{chunk}
+
 \begin{chunk}{PERMCAT.dotfull}
 "PermutationCategory(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PERMCAT"];
 "PermutationCategory(a:SetCategory)" -> "Group()"
 
 \end{chunk}
+
 \begin{chunk}{PERMCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -26866,6 +30141,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{StreamAggregate}{STAGG}
 \pagepic{ps/v102streamaggregate.ps}{STAGG}{0.60}
@@ -26972,6 +30248,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{StreamAggregate.help}
 ====================================================================
 StreamAggregate examples
@@ -27324,12 +30601,96 @@ StreamAggregate(S:Type): Category ==
        x
 
 \end{chunk}
+
+\begin{chunk}{COQ STAGG}
+(* category STAGG *)
+(*
+
+   explicitlyFinite?: % -> Boolean
+   explicitlyFinite? x == not cyclic? x
+
+   possiblyInfinite?: % -> Boolean
+   possiblyInfinite? x == cyclic? x
+
+   first : (%,NonNegativeInteger) -> %
+   first(x, n) == construct [c2(x, x := rest x) for i in 1..n]
+
+   c2: (%, %) -> S
+   c2(x, r) ==
+     empty? x => error "Index out of range"
+     first x
+
+   elt : (%,Integer,S) -> S
+   elt(x:%, i:Integer) ==
+     i := i - minIndex x
+     (i < 0) or empty?(x := rest(x, i::NonNegativeInteger)) => _
+         error "index out of range"
+     first x
+
+   elt(x:%, i:UniversalSegment(Integer)) ==
+     l := lo(i) - minIndex x
+     l < 0 => error "index out of range"
+     not hasHi i => copy(rest(x, l::NonNegativeInteger))
+     (h := hi(i) - minIndex x) < l => empty()
+     first(rest(x, l::NonNegativeInteger), (h - l + 1)::NonNegativeInteger)
+
+   if % has shallowlyMutable then
+
+     concat : (%,%) -> %
+     concat(x:%, y:%) == concat_!(copy x, y)
+
+     concat : List % -> %
+     concat l ==
+       empty? l => empty()
+       concat_!(copy first l, concat rest l)
+
+     map! : ((S -> S),%) -> %
+     map_!(f, l) ==
+       y := l
+       while not empty? l repeat
+         setfirst_!(l, f first l)
+         l := rest l
+       y
+
+     fill! : (%,S) -> %
+     fill_!(x, s) ==
+       y := x
+       while not empty? y repeat (setfirst_!(y, s); y := rest y)
+       x
+
+     setelt : (%,Integer,S) -> S
+     setelt(x:%, i:Integer, s:S) ==
+       i := i - minIndex x
+       (i < 0) or empty?(x := rest(x,i::NonNegativeInteger)) => _
+           error "index out of range"
+       setfirst_!(x, s)
+
+     setelt : (%,UniversalSegment Integer,S) -> S 
+     setelt(x:%, i:UniversalSegment(Integer), s:S) ==
+       (l := lo(i) - minIndex x) < 0 => error "index out of range"
+       h := if hasHi i then hi(i) - minIndex x else maxIndex x
+       h < l => s
+       y := rest(x, l::NonNegativeInteger)
+       z := rest(y, (h - l + 1)::NonNegativeInteger)
+       while not eq?(y, z) repeat (setfirst_!(y, s); y := rest y)
+       s
+
+     concat! : (%,%) -> %
+     concat_!(x:%, y:%) ==
+       empty? x => y
+       setrest_!(tail x, y)
+       x
+*)
+
+\end{chunk}
+
 \begin{chunk}{STAGG.dotabb}
 "STAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=STAGG"];
 "STAGG" -> "RCAGG"
 "STAGG" -> "LNAGG"
 
 \end{chunk}
+
 \begin{chunk}{STAGG.dotfull}
 "StreamAggregate(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=STAGG"];
@@ -27337,6 +30698,7 @@ StreamAggregate(S:Type): Category ==
 "StreamAggregate(a:Type)" -> "LinearAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{STAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -27376,6 +30738,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{TriangularSetCategory}{TSETCAT}
 \pagepic{ps/v102triangularsetcategory.ps}{TSETCAT}{0.35}
@@ -27473,6 +30836,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{TriangularSetCategory.help}
 ====================================================================
 TriangularSetCategory examples
@@ -27624,7 +30988,7 @@ These are implemented by this category:
  coerce : % -> List P
  coHeight : % -> NonNegativeInteger if V has FINITE
  collectQuasiMonic : % -> %           
- collectUnder : (%,V) -> %
+ collectUnder : (%,V) -> %x
  collectUpper : (%,V) -> %            
  construct : List P -> %
  convert : % -> InputForm if P has KONVERT INFORM
@@ -28219,6 +31583,344 @@ TriangularSetCategory(R:IntegralDomain,E:OrderedAbelianMonoidSup,_
          subtractIfCan(n,m)$NonNegativeInteger::NonNegativeInteger
 
 \end{chunk}
+
+\begin{chunk}{COQ TSETCAT}
+(* category TSETCAT *)
+(*
+     
+     GPS ==> GeneralPolynomialSet(R,E,V,P)
+     B ==> Boolean
+     RBT ==> Record(bas:$,top:List P)
+
+     ?=? : (%,%) -> Boolean
+     ts:$ = us:$ ==
+       empty?(ts)$$ => empty?(us)$$
+       empty?(us)$$ => false
+       first(ts)::P =$P first(us)::P => rest(ts)::$ =$$ rest(us)::$
+       false
+
+     infRittWu? : ($,$) -> Boolean
+     infRittWu?(ts,us) ==
+       empty?(us)$$ => not empty?(ts)$$
+       empty?(ts)$$ => false
+       p : P := (last(ts))::P
+       q : P := (last(us))::P
+       infRittWu?(p,q)$P => true
+       supRittWu?(p,q)$P => false
+       v : V := mvar(p)
+       infRittWu?(collectUpper(ts,v),collectUpper(us,v))$$
+
+     reduced? : (P,$,((P,P) -> Boolean)) -> Boolean
+     reduced?(p,ts,redOp?) ==
+       lp : List P := members(ts)
+       while (not empty? lp) and (redOp?(p,first(lp))) repeat
+         lp := rest lp
+       empty? lp 
+
+     basicSet : (List P,((P,P)->Boolean)) -> _
+     basicSet(ps,redOp?) ==
+       ps := remove(zero?,ps)
+       any?(ground?,ps) => "failed"::Union(RBT,"failed")
+       ps := sort(infRittWu?,ps)
+       p,b : P
+       bs := empty()$$
+       ts : List P := []
+       while not empty? ps repeat
+         b := first(ps)
+         bs := extend(bs,b)$$
+         ps := rest ps
+         while (not empty? ps) and _
+               (not reduced?((p := first(ps)),bs,redOp?)) repeat
+           ts := cons(p,ts)
+           ps := rest ps
+       ([bs,ts]$RBT)::Union(RBT,"failed")
+
+     basicSet : (List P,(P->Boolean),((P,P)->Boolean)) -> _
+      Union(Record(bas:$,top:List P),"failed")
+     basicSet(ps,pred?,redOp?) ==
+       ps := remove(zero?,ps)
+       any?(ground?,ps) => "failed"::Union(RBT,"failed")
+       gps : List P := []
+       bps : List P := []
+       while not empty? ps repeat
+         p := first ps
+         ps := rest ps  
+         if pred?(p)
+           then
+             gps := cons(p,gps)
+           else
+             bps := cons(p,bps)
+       gps := sort(infRittWu?,gps)
+       p,b : P
+       bs := empty()$$
+       ts : List P := []
+       while not empty? gps repeat
+         b := first(gps)
+         bs := extend(bs,b)$$
+         gps := rest gps
+         while (not empty? gps) and _
+               (not reduced?((p := first(gps)),bs,redOp?)) repeat
+           ts := cons(p,ts)
+           gps := rest gps
+       ts := sort(infRittWu?,concat(ts,bps))
+       ([bs,ts]$RBT)::Union(RBT,"failed")
+
+     initials : $ -> List P
+     initials ts ==
+       lip : List P := []
+       empty? ts => lip
+       lp := members(ts)
+       while not empty? lp repeat
+          p := first(lp)
+          if not ground?((ip := init(p)))
+            then
+              lip := cons(primPartElseUnitCanonical(ip),lip)
+          lp := rest lp
+       removeDuplicates lip
+
+     degree : $ -> NonNegativeInteger
+     degree ts ==
+       empty? ts => 0$NonNegativeInteger
+       lp := members ts
+       d : NonNegativeInteger := mdeg(first lp)
+       while not empty? (lp := rest lp) repeat
+         d := d * mdeg(first lp)
+       d
+
+     quasiComponent : $ -> Record(close:List P,open:List P)
+     quasiComponent ts == 
+       [members(ts),initials(ts)]
+
+     normalized? : (P,$) -> Boolean
+     normalized?(p,ts) ==
+       normalized?(p,members(ts))$P
+
+     stronglyReduced? : (P,$) -> Boolean
+     stronglyReduced? (p,ts) ==
+       reduced?(p,members(ts))$P
+
+     headReduced? : (P,$) -> Boolean
+     headReduced? (p,ts) ==
+       stronglyReduced?(head(p),ts)
+
+     initiallyReduced? : (P,$) -> Boolean
+     initiallyReduced? (p,ts) ==
+       lp : List (P) := members(ts)
+       red : Boolean := true
+       while (not empty? lp) and (not ground?(p)$P) and red repeat
+         while (not empty? lp) and (mvar(first(lp)) > mvar(p)) repeat 
+           lp := rest lp
+         if (not empty? lp) 
+           then
+             if  (mvar(first(lp)) = mvar(p))
+               then
+                 if reduced?(p,first(lp))
+                   then
+                     lp := rest lp
+                     p := init(p)
+                   else
+                     red := false
+               else
+                 p := init(p)
+       red
+
+     reduce : (P,$,((P,P) -> P),((P,P) -> Boolean) ) -> P
+     reduce(p,ts,redOp,redOp?) ==
+       (empty? ts) or (ground? p) => p
+       ts0 := ts
+       while (not empty? ts) and (not ground? p) repeat
+          reductor := (first ts)::P
+          ts := (rest ts)::$
+          if not redOp?(p,reductor) 
+            then 
+              p := redOp(p,reductor)
+              ts := ts0
+       p
+
+      rewriteSetWithReduction : (List P,$,((P,P) -> P),((P,P) -> Boolean) ) ->_
+        List P
+      rewriteSetWithReduction(lp,ts,redOp,redOp?) ==
+       trivialIdeal? ts => lp
+       lp := remove(zero?,lp)
+       empty? lp => lp
+       any?(ground?,lp) => [1$P]
+       rs : List P := []
+       while not empty? lp repeat
+         p := first lp
+         lp := rest lp
+         p := primPartElseUnitCanonical reduce(p,ts,redOp,redOp?)
+         if not zero? p
+           then 
+             if ground? p
+               then
+                 lp := []
+                 rs := [1$P]
+               else
+                 rs := cons(p,rs)
+       removeDuplicates rs
+
+     stronglyReduce : (P,$) -> P
+     stronglyReduce(p,ts) ==
+       reduce (p,ts,lazyPrem,reduced?)
+
+     headReduce : (P,$) -> P
+     headReduce(p,ts) ==
+       reduce (p,ts,headReduce,headReduced?)
+
+     initiallyReduce : (P,$) -> P
+     initiallyReduce(p,ts) ==
+       reduce (p,ts,initiallyReduce,initiallyReduced?)
+
+     removeZero: (P, $) -> P
+     removeZero(p,ts) ==
+       (ground? p) or (empty? ts) => p
+       v := mvar(p)
+       ts_v_- := collectUnder(ts,v)
+       if algebraic?(v,ts) 
+         then
+           q := lazyPrem(p,select(ts,v)::P)
+           zero? q => return q
+           zero? removeZero(q,ts_v_-) => return 0
+       empty? ts_v_- => p
+       q: P := 0
+       while positive? degree(p,v) repeat
+          q := removeZero(init(p),ts_v_-) * mainMonomial(p) + q
+          p := tail(p)
+       q + removeZero(p,ts_v_-)
+
+     reduceByQuasiMonic: (P, $) -> P
+     reduceByQuasiMonic(p, ts) ==
+       (ground? p) or (empty? ts) => p
+       remainder(p,collectQuasiMonic(ts)).polnum
+
+     autoReduced? : ($,((P,List(P)) -> Boolean)) -> Boolean
+     autoReduced?(ts : $,redOp? : ((P,List(P)) -> Boolean)) ==        
+       empty? ts => true
+       lp : List (P) := members(ts)
+       p : P := first(lp)
+       lp := rest lp
+       while (not empty? lp) and redOp?(p,lp) repeat
+          p := first lp
+          lp := rest lp
+       empty? lp
+
+     stronglyReduced? : $ -> Boolean
+     stronglyReduced? ts ==
+       autoReduced? (ts, reduced?)
+
+     normalized? : $  -> Boolean
+     normalized? ts ==
+       autoReduced? (ts,normalized?)
+
+     headReduced? : $ -> Boolean
+     headReduced? ts ==
+       autoReduced? (ts,headReduced?)
+
+     initiallyReduced? : $ -> Boolean
+     initiallyReduced?  ts ==
+       autoReduced? (ts,initiallyReduced?)
+         
+     mvar : % -> V
+     mvar ts ==
+       empty? ts => error"Error from TSETCAT in mvar : #1 is empty"
+       mvar((first(ts))::P)$P
+
+     first : $ -> Union(P,"failed")
+     first ts ==
+       empty? ts => "failed"::Union(P,"failed")
+       lp : List(P) := sort(supRittWu?,members(ts))$(List P)
+       first(lp)::Union(P,"failed")
+
+     last : $ -> Union(P,"failed")
+     last ts ==
+       empty? ts => "failed"::Union(P,"failed")
+       lp : List(P) := sort(infRittWu?,members(ts))$(List P)
+       first(lp)::Union(P,"failed")
+
+     rest : $ -> Union($,"failed")
+     rest ts ==
+       empty? ts => "failed"::Union($,"failed")
+       lp : List(P) := sort(supRittWu?,members(ts))$(List P)
+       construct(rest(lp))::Union($,"failed")
+
+     coerce : % -> List(P)
+     coerce (ts:$) : List(P) == 
+       sort(supRittWu?,members(ts))$(List P)
+
+     algebraicVariables : $ -> List(V)
+     algebraicVariables ts ==
+       [mvar(p) for p in members(ts)]
+
+     algebraic? : (V,$) -> Boolean
+     algebraic? (v,ts) ==
+       member?(v,algebraicVariables(ts))
+
+     select : (%,V) -> Union(P,"failed")
+     select (ts,v) ==
+       lp : List (P) := sort(supRittWu?,members(ts))$(List P)
+       while (not empty? lp) and (not (v = mvar(first lp))) repeat
+         lp := rest lp
+       empty? lp => "failed"::Union(P,"failed")
+       (first lp)::Union(P,"failed")
+
+     collectQuasiMonic : % -> %
+     collectQuasiMonic ts ==
+       lp: List(P) := members(ts)
+       newlp: List(P) := []
+       while (not empty? lp) repeat
+         if ground? init(first(lp)) then newlp := cons(first(lp),newlp)
+         lp := rest lp
+       construct(newlp)
+
+     collectUnder : (%,V) -> %
+     collectUnder (ts,v) ==
+       lp : List (P) := sort(supRittWu?,members(ts))$(List P)
+       while (not empty? lp) and (not (v > mvar(first lp))) repeat
+         lp := rest lp       
+       construct(lp)
+
+     collectUpper : (%,V) -> %            
+     collectUpper  (ts,v) ==
+       lp1 : List(P) := sort(supRittWu?,members(ts))$(List P)
+       lp2 : List(P) := []
+       while (not empty? lp1) and  (mvar(first lp1) > v) repeat
+         lp2 := cons(first(lp1),lp2)
+         lp1 := rest lp1
+       construct(reverse lp2)
+
+     construct : List P -> %
+     construct(lp:List(P)) ==
+       rif := retractIfCan(lp)@Union($,"failed")
+       not (rif case $) => error"in construct : LP -> $ from TSETCAT : bad arg"
+       rif::$
+
+     retractIfCan : List P -> Union(%,"failed")
+     retractIfCan(lp:List(P)) ==
+       empty? lp => (empty()$$)::Union($,"failed")
+       lp := sort(supRittWu?,lp)
+       rif := retractIfCan(rest(lp))@Union($,"failed")
+       not (rif case $) => _
+        error "in retractIfCan : LP -> ... from TSETCAT : bad arg"
+       extendIfCan(rif::$,first(lp))@Union($,"failed")
+
+     extend : (%,P) -> %
+     extend(ts:$,p:P):$ ==
+       eif := extendIfCan(ts,p)@Union($,"failed")
+       not (eif case $) => error"in extend : ($,P) -> $ from TSETCAT : bad ars"
+       eif::$
+
+     if V has Finite
+     then
+        
+       coHeight : % -> NonNegativeInteger
+       coHeight ts ==
+         n := size()$V
+         m := #(members ts)
+         subtractIfCan(n,m)$NonNegativeInteger::NonNegativeInteger
+*)
+
+\end{chunk}
+
 \begin{chunk}{TSETCAT.dotabb}
 "TSETCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=TSETCAT"];
@@ -28308,6 +32010,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 7}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FiniteDivisorCategory}{FDIVCAT}
@@ -28351,6 +32054,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FiniteDivisorCategory.help}
 ====================================================================
 FiniteDivisorCategory examples
@@ -28484,6 +32188,17 @@ FiniteDivisorCategory(F, UP, UPUP, R): Category == Result where
     principal? d == generator(d) case R
 
 \end{chunk}
+
+\begin{chunk}{COQ FDIVCAT}
+(* category FDIVCAT *)
+(*
+    principal? : % -> Boolean
+    principal? d == generator(d) case R
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FDIVCAT.dotabb}
 "FDIVCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FDIVCAT"];
@@ -28534,6 +32249,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FiniteSetAggregate}{FSAGG}
 \pagepic{ps/v102finitesetaggregate.ps}{FSAGG}{0.75}
@@ -28901,12 +32617,113 @@ FiniteSetAggregate(S:SetCategory): Category ==
        reduce("min", l)
 
 \end{chunk}
+
+\begin{chunk}{COQ FSAGG}
+(* category FSAGG *)
+(*
+
+   ?<? : (%,%) -> Boolean
+   s < t == #s < #t and s = intersect(s,t)
+
+   ?=? : (%,%) -> Boolean
+   s = t == #s = #t and empty? difference(s,t)
+
+   brace : List(S) -> %
+   brace l == construct l
+
+   set : List(S) -> %
+   set l == construct l
+
+   cardinality : % -> NonNegativeInteger
+   cardinality s == #s
+
+   construct : List(S) -> %
+   construct l == (s := set(); for x in l repeat insert_!(x,s); s)
+
+   count : (S,%) -> NonNegativeInteger
+   count(x:S, s:%) == (member?(x, s) => 1; 0)
+
+   subset? : (%,%) -> Boolean
+   subset?(s, t) == #s <= #t and _and/[member?(x, t) for x in parts s]
+
+   coerce : % -> OutputForm
+   coerce(s:%):OutputForm ==
+     brace [x::OutputForm for x in parts s]$List(OutputForm)
+
+   intersect : (%,%) -> %
+   intersect(s, t) ==
+     i := {}
+     for x in parts s | member?(x, t) repeat insert_!(x, i)
+     i
+
+   difference : (%,%) -> %
+   difference(s:%, t:%) ==
+     m := copy s
+     for x in parts t repeat remove_!(x, m)
+     m
+
+   symmetricDifference : (%,%) -> %
+   symmetricDifference(s, t) ==
+     d := copy s
+     for x in parts t repeat
+       if member?(x, s) then remove_!(x, d) else insert_!(x, d)
+     d
+
+   union : (%,%) -> %
+   union(s:%, t:%) ==
+      u := copy s
+      for x in parts t repeat insert_!(x, u)
+      u
+
+   if S has Finite then
+
+     universe : () -> %
+     universe() == {index(i::PositiveInteger) for i in 1..size()$S}
+
+     complement : % -> %
+     complement s == difference(universe(), s )
+
+     size : () -> NonNegativeInteger
+     size() == 2 ** size()$S
+
+     index : PositiveInteger -> %
+     index i ==
+       {index(j::PositiveInteger)$S for j in 1..size()$S | bit?(i-1,j-1)}
+
+     random : () -> %
+     random()  == 
+       index((random()$Integer rem (size()$% + 1))::PositiveInteger)
+
+     lookup : % -> PositiveInteger
+     lookup s ==
+       n:PositiveInteger := 1
+       for x in parts s repeat _
+         n := n + 2 ** ((lookup(x) - 1)::NonNegativeInteger)
+       n
+
+   if S has OrderedSet then
+
+     max : % -> S
+     max s ==
+       empty?(l := parts s) => error "Empty set"
+       reduce("max", l)
+
+     min : % -> S
+     min s ==
+       empty?(l := parts s) => error "Empty set"
+       reduce("min", l)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FSAGG.dotabb}
 "FSAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=FSAGG"];
 "FSAGG" -> "DIAGG"
 "FSAGG" -> "SETAGG"
 
 \end{chunk}
+
 \begin{chunk}{FSAGG.dotfull}
 "FiniteSetAggregate(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FSAGG"];
@@ -28914,6 +32731,7 @@ FiniteSetAggregate(S:SetCategory): Category ==
 "FiniteSetAggregate(a:SetCategory)" -> "SetAggregate(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{FSAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -28946,6 +32764,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{KeyedDictionary}{KDAGG}
 \pagepic{ps/v102keyeddictionary.ps}{KDAGG}{1.00}
@@ -29019,6 +32838,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{KeyedDictionary.help}
 ====================================================================
 KeyedDictionary examples
@@ -29216,11 +33036,34 @@ KeyedDictionary(Key:SetCategory, Entry:SetCategory): Category ==
      keys t == [x.key for x in parts t]
 
 \end{chunk}
+
+\begin{chunk}{COQ KDAGG}
+(* category KDAGG *)
+(*
+
+   key? : (Key,%) -> Boolean
+   key?(k, t) == search(k, t) case Entry
+
+   member? : (Record(key: Key,entry: Entry),%) -> Boolean
+   member?(p, t) ==
+     r := search(p.key, t)
+     r case Entry and r::Entry = p.entry
+
+   if % has finiteAggregate then
+
+     keys : % -> List(Key)
+     keys t == [x.key for x in parts t]
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{KDAGG.dotabb}
 "KDAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=KDAGG"];
 "KDAGG" -> "DIAGG"
 
 \end{chunk}
+
 \begin{chunk}{KDAGG.dotfull}
 "KeyedDictionary(a:SetCategory,b:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=KDAGG"];
@@ -29228,6 +33071,7 @@ KeyedDictionary(Key:SetCategory, Entry:SetCategory): Category ==
     "Dictionary(Record(a:SetCategory,b:SetCategory))"
 
 \end{chunk}
+
 \begin{chunk}{KDAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -29375,6 +33219,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{LazyStreamAggregate.help}
 ====================================================================
 LazyStreamAggregate examples
@@ -30158,18 +34003,432 @@ LazyStreamAggregate(S:Type): Category == StreamAggregate(S) with
     x
 
 \end{chunk}
+
+\begin{chunk}{COQ LZSTAGG}
+(* category LZSTAGG *)
+(*
+
+  MIN ==> 1  -- minimal stream index
+
+  I   ==> Integer
+  NNI ==> NonNegativeInteger
+  L   ==> List
+  U   ==> UniversalSegment Integer
+
+--% SETCAT functions
+
+  if S has SetCategory then
+
+    ?=? : (%,%) -> Boolean
+    x = y ==
+      eq?(x,y) => true
+      explicitlyFinite? x and explicitlyFinite? y =>
+        entries x = entries y
+      explicitEntries? x and explicitEntries? y =>
+        frst x = frst y and EQ(rst x, rst y)$Lisp
+      -- treat cyclic streams
+      false
+
+--% HOAGG functions
+
+  less? : (%,NonNegativeInteger) -> Boolean
+  less?(x,n) ==
+    n = 0    => false
+    empty? x => true
+    less?(rst x,(n-1) :: NNI)
+
+  more? : (%,NonNegativeInteger) -> Boolean
+  more?(x,n) ==
+    empty? x => false
+    n = 0    => true
+    more?(rst x,(n-1) :: NNI)
+
+  size? : (%,NonNegativeInteger) -> Boolean
+  size?(x,n) ==
+    empty? x => n = 0
+    size?(rst x,(n-1) :: NNI)
+
+  #? : % -> NonNegativeInteger
+  # x ==
+    -- error if stream is not finite
+    y := x
+    for i in 0.. repeat
+      explicitlyEmpty? y  => return i
+      lazy? y => error "#: infinite stream"
+      y := rst y
+      if odd? i then x := rst x
+      eq?(x,y) => error "#: infinite stream"
+
+--% CLAGG functions
+
+  any? : ((S -> Boolean),%) -> Boolean
+  any?(f,x) ==
+    -- error message only when x is a stream with lazy
+    -- evaluation and f(s) = false for all stream elements
+    -- 's' which have been computed when the function is
+    -- called
+    y := x
+    for i in 0.. repeat
+      explicitlyEmpty? y  => return false
+      lazy? y => error "any?: infinite stream"
+      f frst y => return true
+      y := rst y
+      if odd? i then x := rst x
+      eq?(x,y) => return false
+
+  every? : ((S -> Boolean),%) -> Boolean
+  every?(f,x) ==
+    -- error message only when x is a stream with lazy
+    -- evaluation and f(s) = true for all stream elements
+    -- 's' which have been computed when the function is
+    -- called
+    y := x
+    for i in 0.. repeat
+      explicitlyEmpty? y => return true
+      lazy? y => error "every?: infinite stream"
+      not f frst y => return false
+      y := rst y
+      if odd? i then x := rst x
+      eq?(x,y) => return true
+
+  entries : % -> List(S)
+  entries x ==
+    -- returns a list of elements which have been computed
+    -- error if infinite
+    y := x
+    l : L S := empty()
+    for i in 0.. repeat
+      explicitlyEmpty? y  => return reverse_! l
+      lazy? y => error "infinite stream"
+      l := concat(frst y,l)
+      y := rst y
+      if odd? i then x := rst x
+      eq?(x,y) => error "infinite stream"
+
+--% CNAGG functions
+
+  construct : List(S) -> %
+  construct l ==
+    empty? l => empty()
+    concat(first l, construct rest l)
+
+--% ELTAGG functions
+
+  elt(x:%,n:I) ==
+    n < MIN or empty? x => error "elt: no such element"
+    n = MIN => frst x
+    elt(rst x,n - 1)
+
+  elt : (%,Integer,S) -> S
+  elt(x:%,n:I,s:S) ==
+    n < MIN or empty? x => s
+    n = MIN => frst x
+    elt(rst x,n - 1)
+
+--% IXAGG functions
+
+  indexx? : (Integer,%) -> Boolean
+  indexx?(n,x) ==
+    empty? x => false
+    n = MIN => true
+    indexx?(n-1,rst x)
+
+  index? : (Integer,%) -> Boolean
+  index?(n,x) ==
+    -- returns 'true' iff 'n' is the index of an entry which
+    -- may or may not have been computed when the function is
+    -- called
+    -- additional entries are computed if necessary
+    n < MIN => false
+    indexx?(n,x)
+
+  indices : % -> List(Integer)
+  indices x ==
+    -- error if stream is not finite
+    y := x
+    l : L I := empty()
+    for i in MIN.. repeat
+      explicitlyEmpty? y  => return reverse_! l
+      lazy? y => error "indices: infinite stream"
+      l := concat(i,l)
+      y := rst y
+      if odd? i then x := rst x
+      eq?(x,y) => error "indices: infinite stream"
+
+  maxIndex : % -> Integer
+  maxIndex x ==
+    -- error if stream is not finite
+    empty? x =>
+      error "maxIndex: no maximal index for empty stream"
+    y := rst x
+    for i in MIN.. repeat
+      explicitlyEmpty? y  => return i
+      lazy? y => error "maxIndex: infinite stream"
+      y := rst y
+      if odd? i then x := rst x
+      eq?(x,y) => error "maxIndex: infinite stream"
+
+  minIndex : % -> Integer
+  minIndex x ==
+    empty? x => error "minIndex: no minimal index for empty stream"
+    MIN
+
+--% LNAGG functions
+
+  delete : (%,Integer) -> %
+  delete(x:%,n:I) ==
+  -- non-destructive
+    not index?(n,x) => error "delete: index out of range"
+    concat(first(x,(n - MIN) :: NNI), rest(x,(n - MIN + 1) :: NNI))
+
+  delete : (%,UniversalSegment(Integer)) -> %
+  delete(x:%,seg:U) ==
+    low := lo seg
+    hasHi seg =>
+      high := hi seg
+      high < low => copy x
+      (not index?(low,x)) or (not index?(high,x)) =>
+        error "delete: index out of range"
+      concat(first(x,(low - MIN) :: NNI),rest(x,(high - MIN + 1) :: NNI))
+    not index?(low,x) => error "delete: index out of range"
+    first(x,(low - MIN) :: NNI)
+
+  elt(x:%,seg:U) ==
+    low := lo seg
+    hasHi seg =>
+      high := hi seg
+      high < low => empty()
+      (not index?(low,x)) or (not index?(high,x)) =>
+        error "elt: index out of range"
+      first(rest(x,(low - MIN) :: NNI),(high - low + 1) :: NNI)
+    not index?(low,x) => error "elt: index out of range"
+    rest(x,(low - MIN) :: NNI)
+
+  insert : (S,%,Integer) -> %
+  insert(s:S,x:%,n:I) ==
+    not index?(n,x) => error "insert: index out of range"
+    nn := (n - MIN) :: NNI
+    concat([first(x,nn), concat(s, empty()), rest(x,nn)])
+
+  insert : (%,%,Integer) -> %
+  insert(y:%,x:%,n:I) ==
+    not index?(n,x) => error "insert: index out of range"
+    nn := (n - MIN) :: NNI
+    concat([first(x,nn), y, rest(x,nn)])
+
+--% RCAGG functions
+
+  cycleElt : % -> Union(%,"failed")
+  cycleElt x == cycleElt(x)$CyclicStreamTools(S,%)
+
+  cyclic? : % -> Boolean
+  cyclic? x ==
+    cycleElt(x) case "failed" => false
+    true
+
+  if S has SetCategory then
+
+    child? : (%,%) -> Boolean
+    child?(x,y) ==
+      empty? y => error "child: no children"
+      x = rst y
+
+  children : % -> List(%)
+  children x ==
+    empty? x => error "children: no children"
+    [rst x]
+
+  distance : (%,%) -> Integer
+  distance(x,z) ==
+    y := x
+    for i in 0.. repeat
+      eq?(y,z) => return i
+      (explicitlyEmpty? y) or (lazy? y) =>
+        error "distance: 2nd arg not a descendent of the 1st"
+      y := rst y
+      if odd? i then x := rst x
+      eq?(x,y) =>
+        error "distance: 2nd arg not a descendent of the 1st"
+
+  if S has SetCategory then
+
+    node? : (%,%) -> Boolean
+    node?(z,x) ==
+      -- error message only when x is a stream with lazy
+      -- evaluation and 'y' is not a node of 'x'
+      -- which has been computed when the function is called
+      y := x
+      for i in 0.. repeat
+        z = y => return true
+        explicitlyEmpty? y => return false
+        lazy? y => error "node?: infinite stream"
+        y := rst y
+        if odd? i then x := rst x
+        eq?(x,y) => return false
+
+  nodes : % -> List(%)
+  nodes x ==
+    y := x
+    l : L % := []
+    for i in 0.. repeat
+      explicitlyEmpty? y => return reverse_! l
+      lazy? y => error "nodes: infinite stream"
+      l := concat(y,l)
+      y := rst y
+      if odd? i then x := rst x
+      eq?(x,y) => error "nodes: infinite stream"
+    l -- @#$%^& compiler
+
+  leaf? : % -> Boolean
+  leaf? x == empty? rest x
+
+  value : % -> S
+  value x == first x
+
+--% URAGG functions
+
+  computeCycleLength : % -> NNI
+  computeCycleLength cycElt ==
+    computeCycleLength(cycElt)$CyclicStreamTools(S,%)
+
+  computeCycleEntry : (%,%) -> %
+  computeCycleEntry(x,cycElt) ==
+    computeCycleEntry(x,cycElt)$CyclicStreamTools(S,%)
+
+  cycleEntry : % -> %
+  cycleEntry x ==
+    cycElt := cycleElt x
+    cycElt case "failed" =>
+      error "cycleEntry: non-cyclic stream"
+    computeCycleEntry(x,cycElt::%)
+
+  cycleLength : % -> NonNegativeInteger
+  cycleLength x ==
+    cycElt := cycleElt x
+    cycElt case "failed" =>
+      error "cycleLength: non-cyclic stream"
+    computeCycleLength(cycElt::%)
+
+  cycleTail : % -> %
+  cycleTail x ==
+    cycElt := cycleElt x
+    cycElt case "failed" =>
+      error "cycleTail: non-cyclic stream"
+    y := x := computeCycleEntry(x,cycElt::%)
+    z := rst x
+    repeat
+      eq?(x,z) => return y
+      y := z ; z := rst z
+
+  ?.first : (%,first) -> S
+  elt(x,"first") == first x
+
+  first : (%,NonNegativeInteger) -> %
+  first(x,n) ==
+  -- former name: take
+    n = 0 or empty? x => empty()
+    concat(frst x, first(rst x,(n-1) :: NNI))
+
+  rest : % -> %
+  rest x ==
+    empty? x => error "Can't take the rest of an empty stream."
+    rst x
+
+  ?.rest : (%,rest) -> %
+  elt(x,"rest") == rest x
+
+  rest : (%,NonNegativeInteger) -> %
+  rest(x,n) ==
+  -- former name: drop
+    n = 0 or empty? x => x
+    rest(rst x,(n-1) :: NNI)
+
+  last : % -> S
+  last x ==
+    -- error if stream is not finite
+    empty? x => error "last: empty stream"
+    y1 := x
+    y2 := rst x
+    for i in 0.. repeat
+      explicitlyEmpty? y2 => return frst y1
+      lazy? y2 => error "last: infinite stream"
+      y1 := y2
+      y2 := rst y2
+      if odd? i then x := rst x
+      eq?(x,y2) => error "last: infinite stream"
+
+  if % has finiteAggregate then -- # is only defined for finiteAggregates
+
+    last : (%,NonNegativeInteger) -> %
+    last(x,n) ==
+      possiblyInfinite? x => error "last: infinite stream"
+      m := # x
+      m < n => error "last: index out of range"
+      copy rest(x,(m-n)::NNI)
+
+  ?.last : (%,last) -> S
+  elt(x,"last") == last x
+
+  tail : % -> %
+  tail x ==
+    -- error if stream is not finite
+    empty? x => error "tail: empty stream"
+    y1 := x
+    y2 := rst x
+    for i in 0.. repeat
+      explicitlyEmpty? y2 => return y1
+      lazy? y2 => error "tail: infinite stream"
+      y1 := y2
+      y2 := rst y2
+      if odd? i then x := rst x
+      eq?(x,y2) => error "tail: infinite stream"
+
+--% STAGG functions
+
+  possiblyInfinite? : % -> Boolean
+  possiblyInfinite? x ==
+    y := x
+    for i in 0.. repeat
+      explicitlyEmpty? y  => return false
+      lazy? y => return true
+      if odd? i then x := rst x
+      y := rst y
+      eq?(x,y) => return true
+
+  explicitlyFinite? : % -> Boolean
+  explicitlyFinite? x == not possiblyInfinite? x
+
+--% LZSTAGG functions
+
+  extend : (%,Integer) -> %
+  extend(x,n) ==
+    y := x
+    for i in 1..n while not empty? y repeat y := rst y
+    x
+
+  complete : % -> %
+  complete x ==
+    y := x
+    while not empty? y repeat y := rst y
+    x
+*)
+
+\end{chunk}
+
 \begin{chunk}{LZSTAGG.dotabb}
 "LZSTAGG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LZSTAGG"];
 "LZSTAGG" -> "STAGG"
 
 \end{chunk}
+
 \begin{chunk}{LZSTAGG.dotfull}
 "LazyStreamAggregate(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LZSTAGG"];
 "LazyStreamAggregate(a:Type)" -> "StreamAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{LZSTAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -30244,6 +34503,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{LeftModule.help}
 ====================================================================
 LeftModule examples
@@ -30368,6 +34628,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ListAggregate}{LSAGG}
 \pagepic{ps/v102listaggregate.ps}{LSAGG}{0.60}
@@ -30499,6 +34760,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ListAggregate.help}
 ====================================================================
 ListAggregate examples
@@ -31026,12 +35288,235 @@ ListAggregate(S:Type): Category == Join(StreamAggregate S,
         false
 
 \end{chunk}
+
+\begin{chunk}{COQ LSAGG}
+(* category LSAGG *)
+(*
+   cycleMax ==> 1000
+
+   sort! : (((S,S) -> Boolean),%) -> %
+   sort_!(f, l) == mergeSort(f, l, #l)
+
+   list : S -> %
+   list x == concat(x, empty())
+
+   reduce : (((S,S) -> S),%) -> S
+   reduce(f, x) ==
+     empty? x => _
+       error "reducing over an empty list needs the 3 argument form"
+     reduce(f, rest x, first x)
+
+   merge : (((S,S) -> Boolean),%,%) -> %
+   merge(f, p, q) == merge_!(f, copy p, copy q)
+
+   select! : ((S -> Boolean),%) -> %
+   select_!(f, x) ==
+     while not empty? x and not f first x repeat x := rest x
+     empty? x => x
+     y := x
+     z := rest y
+     while not empty? z repeat
+       if f first z then (y := z; z := rest z)
+                    else (z := rest z; setrest_!(y, z))
+     x
+
+   merge! : (((S,S) -> Boolean),%,%) -> %
+   merge_!(f, p, q) ==
+     empty? p => q
+     empty? q => p
+     eq?(p, q) => error "cannot merge a list into itself"
+     if f(first p, first q)
+       then (r := t := p; p := rest p)
+       else (r := t := q; q := rest q)
+     while not empty? p and not empty? q repeat
+       if f(first p, first q)
+         then (setrest_!(t, p); t := p; p := rest p)
+         else (setrest_!(t, q); t := q; q := rest q)
+     setrest_!(t, if empty? p then q else p)
+     r
+
+   insert! : (S,%,Integer) -> %
+   insert_!(s:S, x:%, i:Integer) ==
+     i < (m := minIndex x) => error "index out of range"
+     i = m => concat(s, x)
+     y := rest(x, (i - 1 - m)::NonNegativeInteger)
+     z := rest y
+     setrest_!(y, concat(s, z))
+     x
+
+   insert! : (%,%,Integer) -> %
+   insert_!(w:%, x:%, i:Integer) ==
+     i < (m := minIndex x) => error "index out of range"
+     i = m => concat_!(w, x)
+     y := rest(x, (i - 1 - m)::NonNegativeInteger)
+     z := rest y
+     setrest_!(y, w)
+     concat_!(y, z)
+     x
+
+   remove! : ((S -> Boolean),%) -> %
+   remove_!(f:S -> Boolean, x:%) ==
+     while not empty? x and f first x repeat x := rest x
+     empty? x => x
+     p := x
+     q := rest x
+     while not empty? q repeat
+       if f first q then q := setrest_!(p, rest q)
+                    else (p := q; q := rest q)
+     x
+
+   delete! : (%,Integer) -> %
+   delete_!(x:%, i:Integer) ==
+     i < (m := minIndex x) => error "index out of range"
+     i = m => rest x
+     y := rest(x, (i - 1 - m)::NonNegativeInteger)
+     setrest_!(y, rest(y, 2))
+     x
+
+   delete! : (%,UniversalSegment(Integer)) -> %
+   delete_!(x:%, i:UniversalSegment(Integer)) ==
+     (l := lo i) < (m := minIndex x) => error "index out of range"
+     h := if hasHi i then hi i else maxIndex x
+     h < l => x
+     l = m => rest(x, (h + 1 - m)::NonNegativeInteger)
+     t := rest(x, (l - 1 - m)::NonNegativeInteger)
+     setrest_!(t, rest(t, (h - l + 2)::NonNegativeInteger))
+     x
+
+   find : ((S -> Boolean),%) -> Union(S,"failed")
+   find(f, x) ==
+     while not empty? x and not f first x repeat x := rest x
+     empty? x => "failed"
+     first x
+
+   position : ((S -> Boolean),%) -> Integer
+   position(f:S -> Boolean, x:%) ==
+     for k in minIndex(x).. while not empty? x and not f first x repeat
+       x := rest x
+     empty? x => minIndex(x) - 1
+     k
+
+   mergeSort: ((S, S) -> Boolean, %, Integer) -> %
+   mergeSort(f, p, n) ==
+     if n = 2 and f(first rest p, first p) then p := reverse_! p
+     n < 3 => p
+     l := (n quo 2)::NonNegativeInteger
+     q := split_!(p, l)
+     p := mergeSort(f, p, l)
+     q := mergeSort(f, q, n - l)
+     merge_!(f, p, q)
+
+   sorted? : (((S,S) -> Boolean),%) -> Boolean
+   sorted?(f, l) ==
+     empty? l => true
+     p := rest l
+     while not empty? p repeat
+       not f(first l, first p) => return false
+       p := rest(l := p)
+     true
+
+   reduce : (((S,S) -> S),%,S) -> S
+   reduce(f, x, i) ==
+     r := i
+     while not empty? x repeat (r := f(r, first x); x := rest x)
+     r
+
+   if S has SetCategory then
+
+      reduce : (((S,S) -> S),%,S,S) -> S
+      reduce(f, x, i,a) ==
+        r := i
+        while not empty? x and r ^= a repeat
+          r := f(r, first x)
+          x := rest x
+        r
+
+   new : (NonNegativeInteger,S) -> %
+   new(n, s) ==
+     l := empty()
+     for k in 1..n repeat l := concat(s, l)
+     l
+
+   map : (((S,S) -> S),%,%) -> %
+   map(f, x, y) ==
+     z := empty()
+     while not empty? x and not empty? y repeat
+       z := concat(f(first x, first y), z)
+       x := rest x
+       y := rest y
+     reverse_! z
+
+   reverse! : % -> %
+   reverse_! x ==
+     empty? x => x
+     empty?(y := rest x) => x
+     setrest_!(x, empty())
+     while not empty? y repeat
+       z := rest y
+       setrest_!(y, x)
+       x := y
+       y := z
+     x
+
+   copy : % -> %
+   copy x ==
+     y := empty()
+     for k in 0.. while not empty? x repeat
+       k = cycleMax and cyclic? x => error "cyclic list"
+       y := concat(first x, y)
+       x := rest x
+     reverse_! y
+
+   copyInto! : (%,%,Integer) -> %
+   copyInto_!(y, x, s) ==
+     s < (m := minIndex y) => error "index out of range"
+     z := rest(y, (s - m)::NonNegativeInteger)
+     while not empty? z and not empty? x repeat
+       setfirst_!(z, first x)
+       x := rest x
+       z := rest z
+     y
+
+   if S has SetCategory then
+
+     position : (S,%,Integer) -> Integer
+     position(w, x, s) ==
+       s < (m := minIndex x) => error "index out of range"
+       x := rest(x, (s - m)::NonNegativeInteger)
+       for k in s.. while not empty? x and w ^= first x repeat
+         x := rest x
+       empty? x => minIndex x - 1
+       k
+
+     removeDuplicates! : % -> %
+     removeDuplicates_! l ==
+       p := l
+       while not empty? p repeat
+         p := setrest_!(p, remove_!((x:S):Boolean +-> x = first p, rest p))
+       l
+
+   if S has OrderedSet then
+
+     ?<? : (%,%) -> Boolean
+     x < y ==
+        while not empty? x and not empty? y repeat
+          first x ^= first y => return(first x < first y)
+          x := rest x
+          y := rest y
+        empty? x => not empty? y
+        false
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{LSAGG.dotabb}
 "LSAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=LSAGG"];
 "LSAGG" -> "FLAGG"
 "LSAGG" -> "ELAGG"
 
 \end{chunk}
+
 \begin{chunk}{LSAGG.dotfull}
 "ListAggregate(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LSAGG"];
@@ -31045,6 +35530,7 @@ ListAggregate(S:Type): Category == Join(StreamAggregate S,
     "ListAggregate(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{LSAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -31329,6 +35815,7 @@ MultisetAggregate(S:SetCategory):
  Category == Join(MultiDictionary S, SetAggregate S)
 
 \end{chunk}
+
 \begin{chunk}{MSETAGG.dotabb}
 "MSETAGG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MSETAGG"];
@@ -31336,6 +35823,7 @@ MultisetAggregate(S:SetCategory):
 "MSETAGG" -> "SETAGG"
 
 \end{chunk}
+
 \begin{chunk}{MSETAGG.dotfull}
 "MultisetAggregate(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MSETAGG"];
@@ -31343,6 +35831,7 @@ MultisetAggregate(S:SetCategory):
 "MultisetAggregate(a:SetCategory)" -> "SetAggregate(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{MSETAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -31370,6 +35859,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{NonAssociativeRng}{NARNG}
 \pagepic{ps/v102nonassociativerng.ps}{NARNG}{1.00}
@@ -31410,6 +35900,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{NonAssociativeRng.help}
 ====================================================================
 NonAssociativeRng examples
@@ -31525,6 +36016,18 @@ NonAssociativeRng(): Category == Join(AbelianGroup,Monad)  with
     antiCommutator(x,y) == x*y + y*x
 
 \end{chunk}
+
+\begin{chunk}{COQ NARNG}
+(* category NARNG *)
+(*
+++ \tab{5}noZeroDivisors\tab{5} ab = 0 => a=0 or b=0
+    associator(x,y,z) == (x*y)*z - x*(y*z)
+    commutator(x,y) == x*y - y*x
+    antiCommutator(x,y) == x*y + y*x
+*)
+
+\end{chunk}
+
 \begin{chunk}{NARNG.dotabb}
 "NARNG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=NARNG"];
@@ -31669,6 +36172,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OneDimensionalArrayAggregate.help}
 ====================================================================
 OneDimensionalArrayAggregate examples
@@ -32062,7 +36566,6 @@ OneDimensionalArrayAggregate(S:Type): Category ==
       y
 
     construct l ==
---    a := new(#l)
       empty? l => empty()
       a := new(#l, first l)
       for i in minIndex(a).. for x in l repeat qsetelt_!(a, i, x)
@@ -32141,6 +36644,256 @@ OneDimensionalArrayAggregate(S:Type): Category ==
 
 
 \end{chunk}
+
+\begin{chunk}{COQ A1AGG}
+(* category A1AGG *)
+(*
+    parts : % -> List(S)
+    parts x == [qelt(x, i) for i in minIndex x .. maxIndex x]
+
+    sort! : (((S,S) -> Boolean),%) -> %
+    sort_!(f, a) == quickSort(f, a)$FiniteLinearAggregateSort(S, %)
+
+    any? : ((S -> Boolean),%) -> Boolean
+    any?(f, a) ==
+      for i in minIndex a .. maxIndex a repeat
+        f qelt(a, i) => return true
+      false
+
+    every? : ((S -> Boolean),%) -> Boolean
+    every?(f, a) ==
+      for i in minIndex a .. maxIndex a repeat
+        not(f qelt(a, i)) => return false
+      true
+
+    position : ((S -> Boolean),%) -> Integer
+    position(f:S -> Boolean, a:%) ==
+      for i in minIndex a .. maxIndex a repeat
+        f qelt(a, i) => return i
+      minIndex(a) - 1
+
+    find : ((S -> Boolean),%) -> Union(S,"failed")
+    find(f, a) ==
+      for i in minIndex a .. maxIndex a repeat
+        f qelt(a, i) => return qelt(a, i)
+      "failed"
+
+    count : ((S -> Boolean),%) -> NonNegativeInteger
+    count(f:S->Boolean, a:%) ==
+      n:NonNegativeInteger := 0
+      for i in minIndex a .. maxIndex a repeat
+        if f(qelt(a, i)) then n := n+1
+      n
+
+    map! : ((S -> S),%) -> %
+    map_!(f, a) ==
+      for i in minIndex a .. maxIndex a repeat
+        qsetelt_!(a, i, f qelt(a, i))
+      a
+
+    setelt : (%,UniversalSegment(Integer),S) -> S
+    setelt(a:%, s:UniversalSegment(Integer), x:S) ==
+      l := lo s; h := if hasHi s then hi s else maxIndex a
+      l < minIndex a or h > maxIndex a => error "index out of range"
+      for k in l..h repeat qsetelt_!(a, k, x)
+      x
+
+    reduce : (((S,S) -> S),%) -> S
+    reduce(f, a) ==
+      empty? a => error "cannot reduce an empty aggregate"
+      r := qelt(a, m := minIndex a)
+      for k in m+1 .. maxIndex a repeat r := f(r, qelt(a, k))
+      r
+
+    reduce : (((S,S) -> S),%,S) -> S
+    reduce(f, a, identity) ==
+      for k in minIndex a .. maxIndex a repeat
+        identity := f(identity, qelt(a, k))
+      identity
+
+    if S has SetCategory then
+
+       reduce : (((S,S) -> S),%,S,S) -> S
+       reduce(f, a, identity,absorber) ==
+         for k in minIndex a .. maxIndex a while identity ^= absorber
+                repeat identity := f(identity, qelt(a, k))
+         identity
+
+-- this is necessary since new has disappeared.
+-- a and b are not both empty if n > 0
+
+    stupidnew: (NonNegativeInteger, %, %) -> %
+    stupidnew(n, a, b) ==
+      zero? n => empty()
+      new(n, (empty? a => qelt(b, minIndex b); qelt(a, minIndex a)))
+
+-- at least one element of l must be non-empty
+
+    stupidget: List % -> S
+    stupidget l ==
+      for a in l repeat
+        not empty? a => return first a
+      error "Should not happen"
+
+    map : (((S,S) -> S),%,%) -> %
+    map(f, a, b) ==
+      m := max(minIndex a, minIndex b)
+      n := min(maxIndex a, maxIndex b)
+      l := max(0, n - m + 1)::NonNegativeInteger
+      c := stupidnew(l, a, b)
+      for i in minIndex(c).. for j in m..n repeat
+        qsetelt_!(c, i, f(qelt(a, j), qelt(b, j)))
+      c
+
+    merge : (((S,S) -> Boolean),%,%) -> %
+    merge(f, a, b) ==
+      r := stupidnew(#a + #b, a, b)
+      i := minIndex a
+      m := maxIndex a
+      j := minIndex b
+      n := maxIndex b
+      for k in minIndex(r).. while i <= m and j <= n repeat
+        if f(qelt(a, i), qelt(b, j)) then
+          qsetelt_!(r, k, qelt(a, i))
+          i := i+1
+        else
+          qsetelt_!(r, k, qelt(b, j))
+          j := j+1
+      for k in k.. for i in i..m repeat qsetelt_!(r, k, elt(a, i))
+      for k in k.. for j in j..n repeat qsetelt_!(r, k, elt(b, j))
+      r
+
+    ?.? : (%,UniversalSegment(Integer)) -> %
+    elt(a:%, s:UniversalSegment(Integer)) ==
+      l := lo s
+      h := if hasHi s then hi s else maxIndex a
+      l < minIndex a or h > maxIndex a => error "index out of range"
+      r := stupidnew(max(0, h - l + 1)::NonNegativeInteger, a, a)
+      for k in minIndex r.. for i in l..h repeat
+        qsetelt_!(r, k, qelt(a, i))
+      r
+
+    insert : (%,%,Integer) -> %
+    insert(a:%, b:%, i:Integer) ==
+      m := minIndex b
+      n := maxIndex b
+      i < m or i > n => error "index out of range"
+      y := stupidnew(#a + #b, a, b)
+      for k in minIndex y.. for j in m..i-1 repeat
+        qsetelt_!(y, k, qelt(b, j))
+      for k in k.. for j in minIndex a .. maxIndex a repeat
+        qsetelt_!(y, k, qelt(a, j))
+      for k in k.. for j in i..n repeat qsetelt_!(y, k, qelt(b, j))
+      y
+
+    copy : % -> %
+    copy x ==
+      y := stupidnew(#x, x, x)
+      for i in minIndex x .. maxIndex x for j in minIndex y .. repeat
+        qsetelt_!(y, j, qelt(x, i))
+      y
+
+    copyInto! : (%,%,Integer) -> %
+    copyInto_!(y, x, s) ==
+      s < minIndex y or s + #x > maxIndex y + 1 =>
+                                              error "index out of range"
+      for i in minIndex x .. maxIndex x for j in s.. repeat
+        qsetelt_!(y, j, qelt(x, i))
+      y
+
+    construct : List(S) -> %
+    construct l ==
+      empty? l => empty()
+      a := new(#l, first l)
+      for i in minIndex(a).. for x in l repeat qsetelt_!(a, i, x)
+      a
+
+    delete : (%,UniversalSegment(Integer)) -> %
+    delete(a:%, s:UniversalSegment(Integer)) ==
+      l := lo s; h := if hasHi s then hi s else maxIndex a
+      l < minIndex a or h > maxIndex a => error "index out of range"
+      h < l => copy a
+      r := stupidnew((#a - h + l - 1)::NonNegativeInteger, a, a)
+      for k in minIndex(r).. for i in minIndex a..l-1 repeat
+        qsetelt_!(r, k, qelt(a, i))
+      for k in k.. for i in h+1 .. maxIndex a repeat
+        qsetelt_!(r, k, qelt(a, i))
+      r
+
+    delete : (%,Integer) -> %
+    delete(x:%, i:Integer) ==
+      i < minIndex x or i > maxIndex x => error "index out of range"
+      y := stupidnew((#x - 1)::NonNegativeInteger, x, x)
+      for i in minIndex(y).. for j in minIndex x..i-1 repeat
+        qsetelt_!(y, i, qelt(x, j))
+      for i in i .. for j in i+1 .. maxIndex x repeat
+        qsetelt_!(y, i, qelt(x, j))
+      y
+
+    reverse! : % -> %
+    reverse_! x ==
+      m := minIndex x
+      n := maxIndex x
+      for i in 0..((n-m) quo 2) repeat swap_!(x, m+i, n-i)
+      x
+
+    concat : List(%) -> %
+    concat l ==
+      empty? l => empty()
+      n := _+/[#a for a in l]
+      i := minIndex(r := new(n, stupidget l))
+      for a in l repeat
+        copyInto_!(r, a, i)
+        i := i + #a
+      r
+
+    sorted? : (((S,S) -> Boolean),%) -> Boolean
+    sorted?(f, a) ==
+      for i in minIndex(a)..maxIndex(a)-1 repeat
+        not f(qelt(a, i), qelt(a, i + 1)) => return false
+      true
+
+    concat : (%,%) -> %
+    concat(x:%, y:%) ==
+      z := stupidnew(#x + #y, x, y)
+      copyInto_!(z, x, i := minIndex z)
+      copyInto_!(z, y, i + #x)
+      z
+
+    if S has SetCategory then
+
+      ?=? : (%,%) -> Boolean
+      x = y ==
+        #x ^= #y => false
+        for i in minIndex x .. maxIndex x repeat
+          not(qelt(x, i) = qelt(y, i)) => return false
+        true
+
+      coerce : % -> OutputForm
+      coerce(r:%):OutputForm ==
+        bracket commaSeparate
+              [qelt(r, k)::OutputForm for k in minIndex r .. maxIndex r]
+
+      position : (S,%,Integer) -> Integer
+      position(x:S, t:%, s:Integer) ==
+        n := maxIndex t
+        s < minIndex t or s > n => error "index out of range"
+        for k in s..n repeat
+          qelt(t, k) = x => return k
+        minIndex(t) - 1
+
+    if S has OrderedSet then
+
+      ?<? : (%,%) -> Boolean
+      a < b ==
+        for i in minIndex a .. maxIndex a
+          for j in minIndex b .. maxIndex b repeat
+            qelt(a, i) ^= qelt(b, j) => return a.i < b.j
+        #a < #b
+*)
+
+\end{chunk}
+
 \begin{chunk}{A1AGG.dotabb}
 "A1AGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=A1AGG"];
 "A1AGG" -> "FLAGG"
@@ -32302,6 +37055,7 @@ OrderedCancellationAbelianMonoid(): Category ==
         Join(OrderedAbelianMonoid, CancellationAbelianMonoid)
 
 \end{chunk}
+
 \begin{chunk}{OCAMON.dotabb}
 "OCAMON"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OCAMON"];
@@ -32309,6 +37063,7 @@ OrderedCancellationAbelianMonoid(): Category ==
 "OCAMON" -> "CABMON"
 
 \end{chunk}
+
 \begin{chunk}{OCAMON.dotfull}
 "OrderedCancellationAbelianMonoid()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OCAMON"];
@@ -32316,6 +37071,7 @@ OrderedCancellationAbelianMonoid(): Category ==
 "OrderedCancellationAbelianMonoid()" -> "CancellationAbelianMonoid()"
 
 \end{chunk}
+
 \begin{chunk}{OCAMON.dotpic}
 digraph pic {
  fontsize=10;
@@ -32473,7 +37229,8 @@ RegularTriangularSetCategory examples
 The category of regular triangular sets was introduced under the name 
 regular chains in M. KALKBRENER "Three contributions to elimination theory".
 
-In P. AUBRY, D. LAZARD and M. MORENO MAZA "On the Theories of Triangular Sets" it is proved that regular triangular sets and towers of simple
+In P. AUBRY, D. LAZARD and M. MORENO MAZA "On the Theories of Triangular Sets"
+it is proved that regular triangular sets and towers of simple
 extensions of a field are equivalent notions.
 
 In the following definitions, all polynomials and ideals are taken from 
@@ -33110,6 +37867,177 @@ RegularTriangularSetCategory(R:GcdDomain, E:OrderedAbelianMonoidSup,_
        intersect([p],lts)
 
 \end{chunk}
+
+\begin{chunk}{COQ RSETCAT}
+(* category RSETCAT *)
+(*
+
+     NNI ==> NonNegativeInteger
+     INT ==> Integer
+     LP ==> List P
+     PWT ==> Record(val : P, tower : $)
+     LpWT ==> Record(val : (List P), tower : $)
+     Split ==> List $
+     pack ==> PolynomialSetUtilitiesPackage(R,E,V,P)
+
+     purelyAlgebraic? : (P,%) -> Boolean
+     purelyAlgebraic?(p: P, ts: $): Boolean ==
+       ground? p => true
+       not algebraic?(mvar(p),ts) => false
+       algebraicCoefficients?(p,ts)
+
+     purelyTranscendental? : (P,%) -> Boolean
+     purelyTranscendental?(p:P,ts:$): Boolean  ==
+       empty? ts => true
+       lv : List V := variables(p)$P
+       while (not empty? lv) and (not algebraic?(first(lv),ts)) repeat _
+         lv := rest lv
+       empty? lv
+
+     purelyAlgebraicLeadingMonomial? : (P,%) -> Boolean
+     purelyAlgebraicLeadingMonomial?(p: P, ts: $): Boolean  ==
+       ground? p => true
+       algebraic?(mvar(p),ts) and purelyAlgebraicLeadingMonomial?(init(p), ts)
+
+     algebraicCoefficients? : (P,%) -> Boolean
+     algebraicCoefficients?(p:P,ts:$): Boolean  ==
+       ground? p => true
+       (not ground? init(p)) and not (algebraic?(mvar(init(p)),ts)) => false
+       algebraicCoefficients?(init(p),ts) =>
+         ground? tail(p) => true
+         mvar(tail(p)) = mvar(p) => 
+           algebraicCoefficients?(tail(p),ts)
+         algebraic?(mvar(tail(p)),ts) => 
+           algebraicCoefficients?(tail(p),ts)
+         false
+       false
+
+     if V has Finite
+     then
+
+      purelyAlgebraic? : % -> Boolean
+      purelyAlgebraic?(ts: $): Boolean ==
+         empty? ts => true
+         size()$V = #ts => true
+         lp: LP := sort(infRittWu?,members(ts))
+         i: NonNegativeInteger := size()$V
+         for p in lp repeat
+           v: V := mvar(p)
+           (i = (lookup(v)$V)::NNI) => 
+             i := subtractIfCan(i,1)::NNI
+           univariate?(p)$pack => 
+             i := subtractIfCan(i,1)::NNI
+           not algebraicCoefficients?(p,collectUnder(ts,v)) =>
+             return false
+           i := subtractIfCan(i,1)::NNI
+         true
+           
+     else
+
+       purelyAlgebraic? : % -> Boolean
+       purelyAlgebraic?(ts: $): Boolean ==
+         empty? ts => true
+         v: V := mvar(ts)
+         p: P := select(ts,v)::P
+         ts := collectUnder(ts,v)
+         empty? ts => univariate?(p)$pack
+         not purelyAlgebraic?(ts) => false
+         algebraicCoefficients?(p,ts)
+
+     augment : (P,List(%)) -> List(%)
+     augment(p:P,lts:List $) ==
+       toSave: Split := []
+       while not empty? lts repeat
+         ts := first lts
+         lts := rest lts
+         toSave := concat(augment(p,ts),toSave)
+       toSave
+
+     augment : (P,%) -> List(%)
+     augment(lp:LP,ts:$) ==
+       toSave: Split := [ts]
+       empty? lp => toSave
+       lp := sort(infRittWu?,lp)
+       while not empty? lp repeat
+         p := first lp
+         lp := rest lp
+         toSave := augment(p,toSave)
+       toSave
+
+     augment : (List(P),List(%)) -> List(%)
+     augment(lp:LP,lts:List $) ==
+       empty? lp => lts
+       toSave: Split := []
+       while not empty? lts repeat
+         ts := first lts
+         lts := rest lts
+         toSave := concat(augment(lp,ts),toSave)
+       toSave    
+
+     extend : (P,List(%)) -> List(%)
+     extend(p:P,lts:List $) ==
+       toSave : Split := []
+       while not empty? lts repeat
+         ts := first lts
+         lts := rest lts
+         toSave := concat(extend(p,ts),toSave)
+       toSave
+
+     extend : (List(P),List(%)) -> List(%)
+     extend(lp:LP,ts:$) ==
+       toSave: Split := [ts]
+       empty? lp => toSave
+       lp := sort(infRittWu?,lp)
+       while not empty? lp repeat
+         p := first lp
+         lp := rest lp
+         toSave := extend(p,toSave)
+       toSave
+
+     extend : (List(P),%) -> List(%)
+     extend(lp:LP,lts:List $) ==
+       empty? lp => lts
+       toSave: Split := []
+       while not empty? lts repeat
+         ts := first lts
+         lts := rest lts
+         toSave := concat(extend(lp,ts),toSave)
+       toSave    
+
+     intersect : (List(P),List(%)) -> List(%)
+     intersect(lp:LP,lts:List $): List $  ==
+       -- A VERY GENERAL default algorithm
+       (empty? lp) or (empty? lts) => lts
+       lp := [primitivePart(p) for p in lp]
+       lp := removeDuplicates lp
+       lp := remove(zero?,lp)
+       any?(ground?,lp) => []
+       toSee: List LpWT := [[lp,ts]$LpWT for ts in lts]
+       toSave: List $ := []
+       lp: LP
+       p: P
+       ts: $
+       lus: List $
+       while (not empty? toSee) repeat
+         lpwt := first toSee; toSee := rest toSee
+         lp := lpwt.val; ts := lpwt.tower
+         empty? lp => toSave := cons(ts, toSave)
+         p := first lp;  lp := rest lp
+         lus := intersect(p,ts)
+         toSee := concat([[lp,us]$LpWT for us in lus], toSee)
+       toSave
+
+     intersect : (List(P),%) -> List(%)
+     intersect(lp: LP,ts: $): List $  ==
+       intersect(lp,[ts])
+
+     intersect : (P,%) -> List(%)
+     intersect(p: P,lts: List $): List $  ==
+       intersect([p],lts)
+*)
+
+\end{chunk}
+
 \begin{chunk}{RSETCAT.dotabb}
 "RSETCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RSETCAT"];
@@ -33285,6 +38213,18 @@ RightModule(R:Rng):Category == AbelianGroup with
      ++ by the ring element r.
 
 \end{chunk}
+
+\begin{chunk}{COQ RMODULE}
+(* category RMODULE *)
+(*
+Axioms
+   x*(a*b) = (x*a)*b
+   x*(a+b) = (x*a)+(x*b)
+   (x+y)*x = (x*a)+(y*a)
+*)
+
+\end{chunk}
+
 \begin{chunk}{RMODULE.dotabb}
 "RMODULE"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RMODULE"];
@@ -33451,18 +38391,34 @@ These exports come from \refto{SemiGroup}():
 Rng(): Category == Join(AbelianGroup,SemiGroup)
 
 \end{chunk} 
+
+\begin{chunk}{COQ RNG}
+(* category RNG *)
+(*
+Axioms
+  x*(y+z) = x*y + x*z
+  (x+y)*z = x*z + y*z 
+
+Conditional attributes
+  noZeroDivisors ab = 0 => a=0 or b=0
+*)
+
+\end{chunk}
+
 \begin{chunk}{RNG.dotabb}
 "RNG" [color=lightblue,href="bookvol10.2.pdf#nameddest=RNG"];
 "RNG" -> "ABELGRP"
 "RNG" -> "SGROUP"
 
 \end{chunk}
+
 \begin{chunk}{RNG.dotfull}
 "Rng()" [color=lightblue,href="bookvol10.2.pdf#nameddest=RNG"];
 "Rng()" -> "AbelianGroup()"
 "Rng()" -> "SemiGroup()"
 
 \end{chunk}
+
 \begin{chunk}{RNG.dotpic}
 digraph pic {
  fontsize=10;
@@ -33497,6 +38453,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 8}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{BiModule}{BMODULE}
@@ -33633,6 +38590,18 @@ BiModule(R:Ring,S:Ring):Category ==
        ++ \spad{x * 1 = x}
 
 \end{chunk}
+
+\begin{chunk}{COQ BMODULE}
+(* category BMODULE *)
+(*
+Axiom
+  r*(x*s) = (r*x)*s
+leftUnitary   1 * x = x
+rightUnitary  x * 1 = x
+*)
+
+\end{chunk}
+
 \begin{chunk}{BMODULE.dotabb}
 "BMODULE"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=BMODULE"];
@@ -33640,6 +38609,7 @@ BiModule(R:Ring,S:Ring):Category ==
 "BMODULE" -> "RMODULE"
 
 \end{chunk}
+
 \begin{chunk}{BMODULE.dotfull}
 "BiModule(a:Ring,b:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=BMODULE"];
@@ -33655,6 +38625,7 @@ BiModule(R:Ring,S:Ring):Category ==
 "BiModule(a:Ring,b:OrderedAbelianMonoid)" -> "BiModule(a:Ring,b:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{BMODULE.dotpic}
 digraph pic {
  fontsize=10;
@@ -33689,6 +38660,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{BitAggregate}{BTAGG}
 \pagepic{ps/v102bitaggregate.ps}{BTAGG}{0.65}
@@ -33789,6 +38761,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{BitAggregate.help}
 ====================================================================
 BitAggregate examples
@@ -34079,6 +39052,35 @@ BitAggregate(): Category ==
    nor(v, u)  == map(nor, v, u)
 
 \end{chunk}
+
+\begin{chunk}{COQ BTAGG}
+(* category BTAGG *)
+(*
+   ~? : % -> %
+   not v == map(_not, v)
+
+   ^? : % -> %
+   _^ v == map(_not, v)
+
+   ~? : % -> %
+   _~(v) == map(_~, v)
+
+   ?/\? : (%,%) -> %
+   _/_\(v, u) == map(_/_\, v, u)
+
+   ?\/? : (%,%) -> %
+   _\_/(v, u) == map(_\_/, v, u)
+
+   nand : (%,%) -> % 
+   nand(v, u) == map(nand, v, u)
+
+   nor : (%,%) -> %
+   nor(v, u)  == map(nor, v, u)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{BTAGG.dotabb}
 "BTAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=BTAGG"];
 "BTAGG" -> "ORDSET"
@@ -34086,6 +39088,7 @@ BitAggregate(): Category ==
 "BTAGG" -> "A1AGG"
 
 \end{chunk}
+
 \begin{chunk}{BTAGG.dotfull}
 "BitAggregate()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=BTAGG"];
@@ -34094,6 +39097,7 @@ BitAggregate(): Category ==
 "BitAggregate()" -> "OneDimensionalArrayAggregate(Boolean)"
 
 \end{chunk}
+
 \begin{chunk}{BTAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -34312,6 +39316,16 @@ NonAssociativeRing(): Category == Join(NonAssociativeRng,MonadWithUnit) with
       coerce(n) == n * 1$%
 
 \end{chunk}
+
+\begin{chunk}{COQ NASRING}
+(* category NASRING *)
+(*
+      n:Integer
+      coerce(n) == n * 1$%
+*)
+
+\end{chunk}
+
 \begin{chunk}{NASRING.dotabb}
 "NASRING"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=NASRING"];
@@ -34319,6 +39333,7 @@ NonAssociativeRing(): Category == Join(NonAssociativeRng,MonadWithUnit) with
 "NASRING" -> "NARNG"
 
 \end{chunk}
+
 \begin{chunk}{NASRING.dotfull}
 "NonAssociativeRing()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=NASRING"];
@@ -34326,6 +39341,7 @@ NonAssociativeRing(): Category == Join(NonAssociativeRng,MonadWithUnit) with
 "NonAssociativeRing()" -> "MonadWithUnit()"
 
 \end{chunk}
+
 \begin{chunk}{NASRING.dotpic}
 digraph pic {
  fontsize=10;
@@ -34368,6 +39384,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{NormalizedTriangularSetCategory}{NTSCAT}
 \pagepic{ps/v102normalizedtriangularsetcategory.ps}{NTSCAT}{0.45}
@@ -34485,6 +39502,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{NormalizedTriangularSetCategory.help}
 ====================================================================
 NormalizedTriangularSetCategory examples
@@ -34784,12 +39802,14 @@ NormalizedTriangularSetCategory(R:GcdDomain,E:OrderedAbelianMonoidSup,_
          Category ==  RegularTriangularSetCategory(R,E,V,P) 
 
 \end{chunk}
+
 \begin{chunk}{NTSCAT.dotabb}
 "NTSCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=NTSCAT"];
 "NTSCAT" -> "RSETCAT"
 
 \end{chunk}
+
 \begin{chunk}{NTSCAT.dotfull}
 "NormalizedRegularTriangularSetCategory(a:GcdDomain,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=NTSCAT"];
@@ -34846,6 +39866,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OrderedAbelianGroup}{OAGROUP}
 \pagepic{ps/v102orderedabeliangroup.ps}{OAGROUP}{1.00}
@@ -34884,6 +39905,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OrderedAbelianGroup.help}
 ====================================================================
 OrderedAbelianGroup examples
@@ -34965,6 +39987,7 @@ OrderedAbelianGroup(): Category ==
         Join(OrderedCancellationAbelianMonoid, AbelianGroup)
 
 \end{chunk}
+
 \begin{chunk}{OAGROUP.dotabb}
 "OAGROUP"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OAGROUP"];
@@ -34972,6 +39995,7 @@ OrderedAbelianGroup(): Category ==
 "OAGROUP" -> "ABELGRP"
 
 \end{chunk}
+
 \begin{chunk}{OAGROUP.dotfull}
 "OrderedAbelianGroup()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OAGROUP"];
@@ -34979,6 +40003,7 @@ OrderedAbelianGroup(): Category ==
 "OrderedAbelianGroup()" -> "AbelianGroup()"
 
 \end{chunk}
+
 \begin{chunk}{OAGROUP.dotpic}
 digraph pic {
  fontsize=10;
@@ -35003,6 +40028,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OrderedAbelianMonoidSup}{OAMONS}
 \pagepic{ps/v102orderedabelianmonoidsup.ps}{OAMONS}{0.80}
@@ -35040,6 +40066,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OrderedAbelianMonoidSup.help}
 ====================================================================
 OrderedAbelianMonoidSup examples
@@ -35135,18 +40162,32 @@ OrderedAbelianMonoidSup(): Category == OrderedCancellationAbelianMonoid with
     ++ x and y can be subtracted.
 
 \end{chunk}
+
+\begin{chunk}{COQ OAMONS}
+(* category OAMONS *)
+(*
+Axioms
+  sup(a,b)-a \~~= "failed"
+  sup(a,b)-b \~~= "failed"
+  x-a \~~= "failed" and x-b \~~= "failed" => x >= sup(a,b)
+*)
+
+\end{chunk}
+
 \begin{chunk}{OAMONS.dotabb}
 "OAMONS"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OAMONS"];
 "OAMONS" -> "OCAMON"
 
 \end{chunk}
+
 \begin{chunk}{OAMONS.dotfull}
 "OrderedAbelianMonoidSup()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OAMONS"];
 "OrderedAbelianMonoidSup()" -> "OrderedCancellationAbelianMonoid()"
 
 \end{chunk}
+
 \begin{chunk}{OAMONS.dotpic}
 digraph pic {
  fontsize=10;
@@ -35182,6 +40223,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OrderedMultisetAggregate}{OMSAGG}
 \pagepic{ps/v102orderedmultisetaggregate.ps}{OMSAGG}{0.50}
@@ -35257,6 +40299,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OrderedMultisetAggregate.help}
 ====================================================================
 OrderedMultisetAggregate examples
@@ -35460,6 +40503,7 @@ OrderedMultisetAggregate(S:OrderedSet): Category ==
         ++ min(u) returns the smallest entry in the multiset aggregate u.
 
 \end{chunk}
+
 \begin{chunk}{OMSAGG.dotabb}
 "OMSAGG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OMSAGG"];
@@ -35467,6 +40511,7 @@ OrderedMultisetAggregate(S:OrderedSet): Category ==
 "OMSAGG" -> "PRQAGG"
 
 \end{chunk}
+
 \begin{chunk}{OMSAGG.dotfull}
 "OrderedMultisetAggregate(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OMSAGG"];
@@ -35476,6 +40521,7 @@ OrderedMultisetAggregate(S:OrderedSet): Category ==
    "PriorityQueueAggregate(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{OMSAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -35515,6 +40561,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Ring}{RING}
 \pagepic{ps/v102ring.ps}{RING}{1.00}
@@ -35556,6 +40603,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Ring.help}
 ====================================================================
 Ring examples
@@ -35725,6 +40773,16 @@ Ring(): Category == Join(Rng,Monoid,LeftModule(%)) with
       coerce(n) == n * 1$%
 
 \end{chunk}
+
+\begin{chunk}{COQ RING}
+(* category RING *)
+(*
+      n:Integer
+      coerce(n) == n * 1$%
+*)
+
+\end{chunk}
+
 \begin{chunk}{RING.dotabb}
 "RING"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RING"];
@@ -35733,6 +40791,7 @@ Ring(): Category == Join(Rng,Monoid,LeftModule(%)) with
 "RING" -> "LMODULE"
 
 \end{chunk}
+
 \begin{chunk}{RING.dotfull}
 "Ring()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RING"];
@@ -35741,6 +40800,7 @@ Ring(): Category == Join(Rng,Monoid,LeftModule(%)) with
 "Ring()" -> "LeftModule(a:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{RING.dotpic}
 digraph pic {
  fontsize=10;
@@ -35780,6 +40840,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{SquareFreeRegularTriangularSetCategory}{SFRTCAT}
 \pagepic{ps/v102squarefreeregulartriangularsetcategory.ps}{SFRTCAT}{0.50}
@@ -35897,6 +40958,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{SquareFreeRegularTriangularSetCategory.help}
 ====================================================================
 SquareFreeRegularTriangularSetCategory examples
@@ -36188,12 +41250,14 @@ SquareFreeRegularTriangularSetCategory(R:GcdDomain,E:OrderedAbelianMonoidSup,_
    RegularTriangularSetCategory(R,E,V,P) 
 
 \end{chunk}
+
 \begin{chunk}{SFRTCAT.dotabb}
 "SFRTCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SFRTCAT"];
 "SFRTCAT" -> "RSETCAT"
 
 \end{chunk}
+
 \begin{chunk}{SFRTCAT.dotfull}
 "SquareFreeRegularTriangularSetCategory(a:GcdDomain,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SFRTCAT"];
@@ -36202,6 +41266,7 @@ SquareFreeRegularTriangularSetCategory(R:GcdDomain,E:OrderedAbelianMonoidSup,_
 "RegularTriangularSetCategory(a:GcdDomain,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))"
 
 \end{chunk}
+
 \begin{chunk}{SFRTCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -36250,6 +41315,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{StringAggregate}{SRAGG}
 \pagepic{ps/v102stringaggregate.ps}{SRAGG}{1.00}
@@ -36366,6 +41432,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{StringAggregate.help}
 ====================================================================
 StringAggregate examples
@@ -36730,26 +41797,58 @@ StringAggregate: Category == OneDimensionalArrayAggregate Character with
       ++ allow juxtaposition of strings to work as concatenation.
       ++ For example, \axiom{"smoo" "shed"} returns \axiom{"smooshed"}.
  add
-   trim(s: %, c:  Character)          == leftTrim(rightTrim(s, c),        c)
+   trim(s: %, c:  Character) == leftTrim(rightTrim(s, c), c)
+   trim(s: %, cc: CharacterClass) == leftTrim(rightTrim(s, cc), cc)
+   lowerCase s == lowerCase_! copy s
+   upperCase s == upperCase_! copy s
+   prefix?(s, t) == substring?(s, t, minIndex t)
+   coerce(c:Character):% == new(1, c)
+   elt(s:%, t:%): % == concat(s,t)$%
+
+\end{chunk}
+
+\begin{chunk}{COQ SRAGG}
+(* category SRAGG *)
+(*
+
+   trim : (%,Character) -> %
+   trim(s: %, c:  Character) == leftTrim(rightTrim(s, c), c)
+
+   trim : (%,CharacterClass) -> %
    trim(s: %, cc: CharacterClass) == leftTrim(rightTrim(s, cc), cc)
-   lowerCase s                 == lowerCase_! copy s
-   upperCase s                 == upperCase_! copy s
-   prefix?(s, t)         == substring?(s, t, minIndex t)
+
+   lowerCase! : % -> % 
+   lowerCase s == lowerCase_! copy s
+
+   upperCase : % -> %
+   upperCase s == upperCase_! copy s
+
+   prefix? : (%,%) -> Boolean
+   prefix?(s, t) == substring?(s, t, minIndex t)
+
+   coerce : % -> OutputForm
    coerce(c:Character):% == new(1, c)
-   elt(s:%, t:%): %         == concat(s,t)$%
+
+   ?.? : (%,%) -> %
+   elt(s:%, t:%): % == concat(s,t)$%
+
+*)
 
 \end{chunk}
+
 \begin{chunk}{SRAGG.dotabb}
 "SRAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=SRAGG"];
 "SRAGG" -> "A1AGG"
 
 \end{chunk}
+
 \begin{chunk}{SRAGG.dotfull}
 "StringAggregate()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SRAGG"];
 "StringAggregate()" -> "OneDimensionalArrayAggregate(Character)"
 
 \end{chunk}
+
 \begin{chunk}{SRAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -36782,6 +41881,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{TableAggregate}{TBAGG}
 \pagepic{ps/v102tableaggregate.ps}{TBAGG}{0.60}
@@ -36881,6 +41981,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{TableAggregate.help}
 ====================================================================
 TableAggregate examples
@@ -37176,7 +42277,6 @@ TableAggregate(Key:SetCategory, Entry:SetCategory): Category ==
  add
    table()               == empty()
    table l               == dictionary l
--- empty()               == dictionary()
 
    insert_!(p, t)      == (t(p.key) := p.entry; t)
    indices t               == keys t
@@ -37202,18 +42302,125 @@ TableAggregate(Key:SetCategory, Entry:SetCategory): Category ==
       for k in keys s | key?(k, t) repeat z.k := f(s.k, t.k)
       z
 
--- map(f, s, t, x) ==
---    z := table()
---    for k in keys s repeat z.k := f(s.k, t(k, x))
---    for k in keys t | not key?(k, s) repeat z.k := f(t.k, x)
---    z
+   if % has finiteAggregate then
+     parts(t:%):List Record(key:Key,entry:Entry) ==
+         [[k, t.k] for k in keys t]
+     parts(t:%):List Entry   == [t.k for k in keys t]
+     entries(t:%):List Entry == parts(t)
+
+     s:% = t:% ==
+       eq?(s,t) => true
+       #s ^= #t => false
+       for k in keys s repeat
+         (e := search(k, t)) _
+           case "failed" or (e::Entry) ^= s.k => return false
+       true
+
+     map(f: Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry),t:%):%==
+       z := table()
+       for k in keys t repeat
+         ke: Record(key:Key,entry:Entry) := f [k, t.k]
+         z ke.key := ke.entry
+       z
+     map_!(f:Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry),t:%):%_
+      ==
+       lke: List Record(key:Key,entry:Entry) := nil()
+       for k in keys t repeat
+         lke := cons(f [k, remove_!(k,t)::Entry], lke)
+       for ke in lke repeat
+         t ke.key := ke.entry
+       t
+
+     inspect(t: %): Record(key:Key,entry:Entry) ==
+       ks := keys t
+       empty? ks => error "Cannot extract from an empty aggregate"
+       [first ks, t first ks]
+
+     find(f: Record(key:Key,entry:Entry)->Boolean, t:%):_
+           Union(Record(key:Key,entry:Entry), "failed") ==
+       for ke in parts(t)@List(Record(key:Key,entry:Entry)) _
+          repeat if f ke then return ke
+       "failed"
+
+     index?(k: Key, t: %): Boolean ==
+       search(k,t) case Entry
+
+     remove_!(x:Record(key:Key,entry:Entry), t:%) ==
+       if member?(x, t) then remove_!(x.key, t)
+       t
+     extract_!(t: %): Record(key:Key,entry:Entry) ==
+       k: Record(key:Key,entry:Entry) := inspect t
+       remove_!(k.key, t)
+       k
+
+     any?(f: Entry->Boolean, t: %): Boolean ==
+       for k in keys t | f t k repeat return true
+       false
+     every?(f: Entry->Boolean, t: %): Boolean ==
+       for k in keys t | not f t k repeat return false
+       true
+     count(f: Entry->Boolean, t: %): NonNegativeInteger ==
+       tally: NonNegativeInteger := 0
+       for k in keys t | f t k repeat tally := tally + 1
+       tally
+
+\end{chunk}
+
+\begin{chunk}{COQ TBAGG}
+(* category TBAGG *)
+(*
+
+   table : () -> %
+   table() == empty()
+
+   table : List(Record(key: Key,entry: Entry)) -> %
+   table l == dictionary l
+
+   insert! : (Record(key: Key,entry: Entry),%) -> %
+   insert_!(p, t) == (t(p.key) := p.entry; t)
+
+   indices : % -> List(Key)
+   indices t               == keys t
+
+   coerce : % -> OutputForm
+   coerce(t:%):OutputForm ==
+     prefix("table"::OutputForm,
+                    [k::OutputForm = (t.k)::OutputForm for k in keys t])
+
+   ?.? : (%,Key) -> Entry
+   elt(t, k) ==
+      (r := search(k, t)) case Entry => r::Entry
+      error "key not in table"
+
+   elt : (%,Key,Entry) -> Entry
+   elt(t, k, e) ==
+      (r := search(k, t)) case Entry => r::Entry
+      e
+
+   map! : ((Entry -> Entry),%) -> %
+   map_!(f, t) ==
+      for k in keys t repeat t.k := f t.k
+      t
+
+   map : (((Entry,Entry) -> Entry),%,%) -> %
+   map(f:(Entry, Entry) -> Entry, s:%, t:%) ==
+      z := table()
+      for k in keys s | key?(k, t) repeat z.k := f(s.k, t.k)
+      z
 
    if % has finiteAggregate then
+
+     parts : % -> List(Record(key: Key,entry: Entry))
      parts(t:%):List Record(key:Key,entry:Entry) ==
          [[k, t.k] for k in keys t]
+
+     parts : % -> List(Entry)
      parts(t:%):List Entry   == [t.k for k in keys t]
+
+     entries : % -> List(Entry)
      entries(t:%):List Entry == parts(t)
 
+     ?=? : (%,%) -> Boolean
      s:% = t:% ==
        eq?(s,t) => true
        #s ^= #t => false
@@ -37222,12 +42429,17 @@ TableAggregate(Key:SetCategory, Entry:SetCategory): Category ==
            case "failed" or (e::Entry) ^= s.k => return false
        true
 
+     map : ((Record(key: Key,entry: Entry) -> 
+              Record(key: Key,entry: Entry)),%) -> %
      map(f: Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry),t:%):%==
        z := table()
        for k in keys t repeat
          ke: Record(key:Key,entry:Entry) := f [k, t.k]
          z ke.key := ke.entry
        z
+
+     map! : ((Record(key: Key,entry: Entry) ->
+              Record(key: Key,entry: Entry)),%) -> %
      map_!(f:Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry),t:%):%_
       ==
        lke: List Record(key:Key,entry:Entry) := nil()
@@ -37237,46 +42449,62 @@ TableAggregate(Key:SetCategory, Entry:SetCategory): Category ==
          t ke.key := ke.entry
        t
 
+     inspect : % -> Record(key: Key,entry: Entry)
      inspect(t: %): Record(key:Key,entry:Entry) ==
        ks := keys t
        empty? ks => error "Cannot extract from an empty aggregate"
        [first ks, t first ks]
 
+     find : ((Record(key: Key,entry: Entry) -> Boolean),%) ->
+              Union(Record(key: Key,entry: Entry),"failed")
      find(f: Record(key:Key,entry:Entry)->Boolean, t:%):_
            Union(Record(key:Key,entry:Entry), "failed") ==
        for ke in parts(t)@List(Record(key:Key,entry:Entry)) _
           repeat if f ke then return ke
        "failed"
 
+     index? : (Key,%) -> Boolean
      index?(k: Key, t: %): Boolean ==
        search(k,t) case Entry
 
+     remove! : (Record(key: Key,entry: Entry),%) -> %
      remove_!(x:Record(key:Key,entry:Entry), t:%) ==
        if member?(x, t) then remove_!(x.key, t)
        t
+
+     extract! : % -> Record(key: Key,entry: Entry)
      extract_!(t: %): Record(key:Key,entry:Entry) ==
        k: Record(key:Key,entry:Entry) := inspect t
        remove_!(k.key, t)
        k
 
+     any? : ((Entry -> Boolean),%) -> Boolean
      any?(f: Entry->Boolean, t: %): Boolean ==
        for k in keys t | f t k repeat return true
        false
+
+     every? : ((Entry -> Boolean),%) -> Boolean
      every?(f: Entry->Boolean, t: %): Boolean ==
        for k in keys t | not f t k repeat return false
        true
+
+     count : ((Entry -> Boolean),%) -> NonNegativeInteger
      count(f: Entry->Boolean, t: %): NonNegativeInteger ==
        tally: NonNegativeInteger := 0
        for k in keys t | f t k repeat tally := tally + 1
        tally
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{TBAGG.dotabb}
 "TBAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=TBAGG"];
 "TBAGG" -> "KDAGG"
 "TBAGG" -> "IXAGG"
 
 \end{chunk}
+
 \begin{chunk}{TBAGG.dotfull}
 "TableAggregate(a:SetCategory,b:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=TBAGG"];
@@ -37286,6 +42514,7 @@ TableAggregate(Key:SetCategory, Entry:SetCategory): Category ==
     "IndexedAggregate(a:SetCategory,b:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{TBAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -37337,6 +42566,7 @@ digraph pic {
 "HOAGG..." [color=lightblue];
 }
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{VectorCategory}{VECTCAT}
 \pagepic{ps/v102vectorcategory.ps}{VECTCAT}{1.00}
@@ -37768,12 +42998,82 @@ VectorCategory(R:Type): Category == OneDimensionalArrayAggregate R with
          sqrt(dot(p,p))
  
 \end{chunk}
+
+\begin{chunk}{COQ VECTCAT}
+(* category VECTCAT *)
+(*
+
+    if R has AbelianSemiGroup then
+
+      ?+? : (%,%) -> %
+      u + v ==
+        (n := #u) ^= #v => error "Vectors must be of the same length"
+        map(_+ , u, v)
+ 
+    if R has AbelianMonoid then
+
+      zero : NonNegativeInteger -> %
+      zero n == new(n, 0)
+ 
+    if R has AbelianGroup then
+
+      -? : % -> %
+      - u == map(x +-> -x, u)
+
+      ?*? : (Integer,%) -> %
+      n:Integer * u:% == map(x +-> n * x, u)
+
+      ?-? : (%,%) -> %
+      u - v == u + (-v)
+ 
+    if R has Monoid then
+
+      ?*? : (%,R) -> %
+      u:% * r:R == map(x +-> x * r, u)
+
+      ?*? : (R,%) -> %
+      r:R * u:% == map(x +-> r * x, u)
+ 
+    if R has Ring then
+
+      dot : (%,%) -> R
+      dot(u, v) ==
+        #u ^= #v => error "Vectors must be of the same length"
+        _+/[qelt(u, i) * qelt(v, i) for i in minIndex u .. maxIndex u]
+
+      outerProduct : (%,%) -> Matrix(R)
+      outerProduct(u, v) ==
+        matrix [[qelt(u, i) * qelt(v,j) for i in minIndex u .. maxIndex u] _
+                for j in minIndex v .. maxIndex v]
+
+      cross : (%,%) -> %
+      cross(u, v) ==
+        #u ^= 3 or #v ^= 3 => error "Vectors must be of length 3"
+        construct [qelt(u, 2)*qelt(v, 3) - qelt(u, 3)*qelt(v, 2) , _
+                   qelt(u, 3)*qelt(v, 1) - qelt(u, 1)*qelt(v, 3) , _
+                   qelt(u, 1)*qelt(v, 2) - qelt(u, 2)*qelt(v, 1) ]
+
+    if R has RadicalCategory and R has Ring then
+
+      length : % -> R
+      length p ==
+         sqrt(dot(p,p))
+
+      magnitude : % -> R
+      magnitude p ==
+         sqrt(dot(p,p))
+ 
+*)
+
+\end{chunk}
+
 \begin{chunk}{VECTCAT.dotabb}
 "VECTCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=VECTCAT"];
 "VECTCAT" -> "A1AGG"
 
 \end{chunk}
+
 \begin{chunk}{VECTCAT.dotfull}
 "VectorCategory(a:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=VECTCAT"];
@@ -37784,6 +43084,7 @@ VectorCategory(R:Type): Category == OneDimensionalArrayAggregate R with
 "VectorCategory(a:Ring)" -> "VectorCategory(a:Type)"
 
 \end{chunk}
+
 \begin{chunk}{VECTCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -37812,6 +43113,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 9}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{AssociationListAggregate}{ALAGG}
@@ -38018,6 +43320,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{AssociationListAggregate.help}
 ====================================================================
 AssociationListAggregate examples
@@ -38482,12 +43785,14 @@ AssociationListAggregate(Key:SetCategory,Entry:SetCategory): Category ==
         ++ with key k, or "failed" if u has no key k.
 
 \end{chunk}
+
 \begin{chunk}{ALAGG.dotabb}
 "ALAGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=ALAGG"];
 "ALAGG" -> "TBAGG"
 "ALAGG" -> "LSAGG"
 
 \end{chunk}
+
 \begin{chunk}{ALAGG.dotfull}
 "AssociationListAggregate(a:SetCategory,b:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ALAGG"];
@@ -38497,6 +43802,7 @@ AssociationListAggregate(Key:SetCategory,Entry:SetCategory): Category ==
     "ListAggregate(Record(a:SetCategory,b:SetCategory))"
 
 \end{chunk}
+
 \begin{chunk}{ALAGG.dotpic}
 digraph pic {
  fontsize=10;
@@ -38537,6 +43843,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CharacteristicNonZero}{CHARNZ}
 \pagepic{ps/v102characteristicnonzero.ps}{CHARNZ}{0.90}
@@ -38579,6 +43886,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{CharacteristicNonZero.help}
 ====================================================================
 CharacteristicNonZero examples
@@ -38676,18 +43984,21 @@ CharacteristicNonZero():Category == Ring with
        ++ where p is the characteristic of the ring.
 
 \end{chunk}
+
 \begin{chunk}{CHARNZ.dotabb}
 "CHARNZ"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=CHARNZ"];
 "CHARNZ" -> "RING"
 
 \end{chunk}
+
 \begin{chunk}{CHARNZ.dotfull}
 "CharacteristicNonZero()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=CHARNZ"];
 "CharacteristicNonZero()" -> "Ring()"
 
 \end{chunk}
+
 \begin{chunk}{CHARNZ.dotpic}
 digraph pic {
  fontsize=10;
@@ -38730,6 +44041,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CharacteristicZero}{CHARZ}
 \pagepic{ps/v102characteristiczero.ps}{CHARZ}{0.90}
@@ -38771,6 +44083,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{CharacteristicZero.help}
 ====================================================================
 CharacteristicZero examples
@@ -38916,6 +44229,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{CommutativeRing}{COMRING}
 \pagepic{ps/v102commutativering.ps}{COMRING}{0.65}
@@ -38957,6 +44271,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{CommutativeRing.help}
 ====================================================================
 CommutativeRing examples
@@ -39063,6 +44378,7 @@ CommutativeRing():Category == Join(Ring,BiModule(%,%)) with
     commutative("*")  ++ multiplication is commutative.
 
 \end{chunk}
+
 \begin{chunk}{COMRING.dotabb}
 "COMRING"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=COMRING"];
@@ -39070,6 +44386,7 @@ CommutativeRing():Category == Join(Ring,BiModule(%,%)) with
 "COMRING" -> "BMODULE"
 
 \end{chunk}
+
 \begin{chunk}{COMRING.dotfull}
 "CommutativeRing()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=COMRING"];
@@ -39077,6 +44394,7 @@ CommutativeRing():Category == Join(Ring,BiModule(%,%)) with
 "CommutativeRing()" -> "BiModule(a:Ring,b:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{COMRING.dotpic}
 digraph pic {
  fontsize=10;
@@ -39130,6 +44448,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{DifferentialRing}{DIFRING}
 \pagepic{ps/v102differentialring.ps}{DIFRING}{0.90}
@@ -39173,6 +44492,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{DifferentialRing.help}
 ====================================================================
 DifferentialRing examples
@@ -39302,18 +44622,40 @@ DifferentialRing(): Category == Ring with
     D(r,n) == differentiate(r,n)
 
 \end{chunk}
+
+\begin{chunk}{COQ DIFRING}
+(* category DIFRING *)
+(*
+
+    D : % -> %
+    D r == differentiate r
+
+    differentiate : (%,NonNegativeInteger) -> %
+    differentiate(r, n) ==
+      for i in 1..n repeat r := differentiate r
+      r
+
+    D : (%,NonNegativeInteger) -> %
+    D(r,n) == differentiate(r,n)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{DIFRING.dotabb}
 "DIFRING"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DIFRING"];
 "DIFRING" -> "RING"
 
 \end{chunk}
+
 \begin{chunk}{DIFRING.dotfull}
 "DifferentialRing()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DIFRING"];
 "DifferentialRing()" -> "Ring()"
 
 \end{chunk}
+
 \begin{chunk}{DIFRING.dotpic}
 digraph pic {
  fontsize=10;
@@ -39356,6 +44698,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{EntireRing}{ENTIRER}
 \pagepic{ps/v102EntireRing.ps}{ENTIRER}{0.65}
@@ -39397,6 +44740,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{EntireRing.help}
 ====================================================================
 EntireRing examples
@@ -39503,6 +44847,21 @@ EntireRing():Category == Join(Ring,BiModule(%,%)) with
                       ++ must be zero.
 
 \end{chunk}
+
+\begin{chunk}{COQ ENTIRER}
+(* category ENTIRER *)
+(*
+Entire Rings (non-commutative Integral Domains), i.e. a ring
+not necessarily commutative which has no zero divisors.
+
+Axioms
+noZeroDivisors  ab=0 => a=0 or b=0
+  not(1=0)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ENTIRER.dotabb}
 "ENTIRER"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ENTIRER"];
@@ -39510,6 +44869,7 @@ EntireRing():Category == Join(Ring,BiModule(%,%)) with
 "ENTIRER" -> "BMODULE"
 
 \end{chunk}
+
 \begin{chunk}{ENTIRER.dotfull}
 "EntireRing()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ENTIRER"];
@@ -39517,6 +44877,7 @@ EntireRing():Category == Join(Ring,BiModule(%,%)) with
 "EntireRing()" -> "BiModule(a:Ring,b:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{ENTIRER.dotpic}
 digraph pic {
  fontsize=10;
@@ -39565,6 +44926,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FreeModuleCat}{FMCAT}
 \pagepic{ps/v102freemodulecat.ps}{FMCAT}{0.75}
@@ -39611,6 +44973,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FreeModuleCat.help}
 ====================================================================
 FreeModuleCat examples
@@ -39784,6 +45147,7 @@ FreeModuleCat(R, Basis):Category == Exports where
      if R has CommutativeRing then Module(R)
 
 \end{chunk}
+
 \begin{chunk}{FMCAT.dotabb}
 "FMCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FMCAT"];
@@ -39791,6 +45155,7 @@ FreeModuleCat(R, Basis):Category == Exports where
 "FMCAT" -> "RETRACT"
 
 \end{chunk}
+
 \begin{chunk}{FMCAT.dotfull}
 "FreeModuleCat(a:Ring,b:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FMCAT"];
@@ -39798,6 +45163,7 @@ FreeModuleCat(R, Basis):Category == Exports where
 "FreeModuleCat(a:Ring,b:SetCategory)" -> "RetractableTo(SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{FMCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -39836,6 +45202,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{LeftAlgebra}{LALG}
 \pagepic{ps/v102leftalgebra.ps}{LALG}{1.00}
@@ -39878,6 +45245,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{LeftAlgebra.help}
 ====================================================================
 LeftAlgebra examples
@@ -39980,6 +45348,17 @@ LeftAlgebra(R:Ring): Category == Join(Ring, LeftModule R) with
       coerce(x:R):% == x * 1$%
 
 \end{chunk}
+
+\begin{chunk}{COQ LALG}
+(* category LALG *)
+(*
+      coerce : R -> %
+      coerce(x:R):% == x * 1$%
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{LALG.dotabb}
 "LALG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LALG"];
@@ -39987,6 +45366,7 @@ LeftAlgebra(R:Ring): Category == Join(Ring, LeftModule R) with
 "LALG" -> "RING"
 
 \end{chunk}
+
 \begin{chunk}{LALG.dotfull}
 "LeftAlgebra(a:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LALG"];
@@ -39994,6 +45374,7 @@ LeftAlgebra(R:Ring): Category == Join(Ring, LeftModule R) with
 "LeftAlgebra(a:Ring)" -> "Ring()"
 
 \end{chunk}
+
 \begin{chunk}{LALG.dotpic}
 digraph pic {
  fontsize=10;
@@ -40027,6 +45408,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{LinearlyExplicitRingOver}{LINEXP}
 \pagepic{ps/v102linearlyexplicitringover.ps}{LINEXP}{0.90}
@@ -40070,6 +45452,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{LinearlyExplicitRingOver.help}
 ====================================================================
 LinearlyExplicitRingOver examples
@@ -40170,12 +45553,14 @@ LinearlyExplicitRingOver(R:Ring): Category == Ring with
     ++ \spad{A x = v} and \spad{B x = w} have the same solutions in R.
 
 \end{chunk}
+
 \begin{chunk}{LINEXP.dotabb}
 "LINEXP"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LINEXP"];
 "LINEXP" -> "RING"
 
 \end{chunk}
+
 \begin{chunk}{LINEXP.dotfull}
 "LinearlyExplicitRingOver(a:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LINEXP"];
@@ -40191,6 +45576,7 @@ LinearlyExplicitRingOver(R:Ring): Category == Ring with
     "LinearlyExplicitRingOver(a:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{LINEXP.dotpic}
 digraph pic {
  fontsize=10;
@@ -40233,6 +45619,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Module}{MODULE}
 \pagepic{ps/v102module.ps}{MODULE}{1.00}
@@ -40269,6 +45656,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Module.help}
 ====================================================================
 Module examples
@@ -40362,12 +45750,29 @@ Module(R:CommutativeRing): Category == BiModule(R,R)
     if not(R is %) then x:%*r:R == r*x
 
 \end{chunk}
+
+\begin{chunk}{COQ MODULE}
+(* category MODULE *)
+(*
+The category of modules over a commutative ring.
+
+Axioms
+  1*x = x
+  (a*b)*x = a*(b*x)
+  (a+b)*x = (a*x)+(b*x)
+  a*(x+y) = (a*x)+(a*y)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{MODULE.dotabb}
 "MODULE"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MODULE"];
 "MODULE" -> "BMODULE"
 
 \end{chunk}
+
 \begin{chunk}{MODULE.dotfull}
 "Module(a:CommutativeRing)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MODULE"];
@@ -40379,6 +45784,7 @@ Module(R:CommutativeRing): Category == BiModule(R,R)
 "Module(Field)" -> "Module(a:CommutativeRing)"
 
 \end{chunk}
+
 \begin{chunk}{MODULE.dotpic}
 digraph pic {
  fontsize=10;
@@ -40412,6 +45818,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OrderedRing}{ORDRING}
 \pagepic{ps/v102orderedring.ps}{ORDRING}{0.75}
@@ -40458,6 +45865,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OrderedRing.help}
 ====================================================================
 OrderedRing examples
@@ -40606,6 +46014,37 @@ OrderedRing(): Category == Join(OrderedAbelianGroup,Ring,Monoid) with
        error "x satisfies neither positive?, negative? or zero?"
 
 \end{chunk}
+
+\begin{chunk}{COQ ORDRING}
+(* category ORDRING *)
+(*
+Axiom
+  0<a and b<c => ab< ac
+
+     positive? : % -> Boolean
+     positive? x == x>0
+
+     negative? : % -> Boolean
+     negative? x == x<0
+
+     sign : % -> Integer
+     sign x ==
+       positive? x => 1
+       negative? x => -1
+       zero? x => 0
+       error "x satisfies neither positive?, negative? or zero?"
+
+     abs : % -> %
+     abs x ==
+       positive? x => x
+       negative? x => -x
+       zero? x => 0
+       error "x satisfies neither positive?, negative? or zero?"
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ORDRING.dotabb}
 "ORDRING"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDRING"];
@@ -40614,6 +46053,7 @@ OrderedRing(): Category == Join(OrderedAbelianGroup,Ring,Monoid) with
 "ORDRING" -> "MONOID"
 
 \end{chunk}
+
 \begin{chunk}{ORDRING.dotfull}
 "OrderedRing()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ORDRING"];
@@ -40622,6 +46062,7 @@ OrderedRing(): Category == Join(OrderedAbelianGroup,Ring,Monoid) with
 "OrderedRing()" -> "Monoid()"
 
 \end{chunk}
+
 \begin{chunk}{ORDRING.dotpic}
 digraph pic {
  fontsize=10;
@@ -40666,6 +46107,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PartialDifferentialRing}{PDRING}
 \pagepic{ps/v102partialdifferentialring.ps}{PDRING}{1.00}
@@ -40712,6 +46154,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PartialDifferentialRing.help}
 ====================================================================
 PartialDifferentialRing examples
@@ -40879,12 +46322,52 @@ PartialDifferentialRing(S:SetCategory): Category == Ring with
     D(r:%, lv:List S, ln:List NonNegativeInteger) == differentiate(r, lv, ln)
 
 \end{chunk}
+
+\begin{chunk}{COQ PDRING}
+(* category PDRING *)
+(*
+Axioms
+  differentiate(x+y,e)=differentiate(x,e)+differentiate(y,e)
+  differentiate(x*y,e)=x*differentiate(y,e)+differentiate(x,e)*y
+
+    differentiate : (%,List(S)) -> %
+    differentiate(r:%, l:List S) ==
+      for s in l repeat r := differentiate(r, s)
+      r
+
+    differentiate : (%,S,NonNegativeInteger) -> %
+    differentiate(r:%, s:S, n:NonNegativeInteger) ==
+      for i in 1..n repeat r := differentiate(r, s)
+      r
+
+    differentiate : (%,List(S),List(NonNegativeInteger)) -> %
+    differentiate(r:%, ls:List S, ln:List NonNegativeInteger) ==
+      for s in ls for n in ln repeat r := differentiate(r, s, n)
+      r
+
+    D : (%,S) -> %
+    D(r:%, v:S) == differentiate(r,v)
+
+    D : (%,List(S)) -> %
+    D(r:%, lv:List S) == differentiate(r,lv)
+
+    D : (%,S,NonNegativeInteger) -> %
+    D(r:%, v:S, n:NonNegativeInteger) == differentiate(r,v,n)
+
+    D : (%,List(S),List(NonNegativeInteger)) -> %
+    D(r:%, lv:List S, ln:List NonNegativeInteger) == differentiate(r, lv, ln)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{PDRING.dotabb}
 "PDRING"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PDRING"];
 "PDRING" -> "RING"
 
 \end{chunk}
+
 \begin{chunk}{PDRING.dotfull}
 "PartialDifferentialRing(a:SetCategory)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PDRING"];
@@ -40901,6 +46384,7 @@ PartialDifferentialRing(S:SetCategory): Category == Ring with
     "PartialDifferentialRing(a:SetCategory)"
 
 \end{chunk}
+
 \begin{chunk}{PDRING.dotpic}
 digraph pic {
  fontsize=10;
@@ -40943,6 +46427,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PointCategory}{PTCAT}
 \pagepic{ps/v102pointcategory.ps}{PTCAT}{1.00}
@@ -41050,6 +46535,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PointCategory.help}
 ====================================================================
 PointCategory examples
@@ -41288,18 +46774,21 @@ PointCategory(R:Ring) : Category == VectorCategory(R) with
         ++ extend(x,l,r) \undocumented
 
 \end{chunk}
+
 \begin{chunk}{PTCAT.dotabb}
 "PTCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PTCAT"];
 "PTCAT" -> "VECTCAT"
 
 \end{chunk}
+
 \begin{chunk}{PTCAT.dotfull}
 "PointCategory(a:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PTCAT"];
 "PointCategory(a:Ring)" -> "VectorCategory(a:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{PTCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -41334,6 +46823,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{RectangularMatrixCategory}{RMATCAT}
 \pagepic{ps/v102rectangularmatrixcategory.ps}{RMATCAT}{0.45}
@@ -41418,6 +46908,7 @@ The RectangularMatrix domain is matrices of fixed dimension.
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{RectangularMatrixCategory.help}
 ====================================================================
 RectangularMatrixCategory examples
@@ -41765,6 +47256,51 @@ RectangularMatrixCategory(m,n,R,Row,Col): Category == Definition where
        true
 
 \end{chunk}
+
+\begin{chunk}{COQ RMATCAT}
+(* category RMATCAT *)
+(*
+     nrows : % -> NonNegativeInteger
+     nrows x == m
+
+     ncols : % -> NonNegativeInteger
+     ncols x == n
+
+     square? : % -> Boolean
+     square? x == m = n
+
+     diagonal? : % -> Boolean
+     diagonal? x ==
+       not square? x => false
+       for i in minRowIndex x .. maxRowIndex x repeat
+         for j in minColIndex x .. maxColIndex x
+           | (j - minColIndex x) ^= (i - minRowIndex x) repeat
+             not zero? qelt(x, i, j) => return false
+       true
+
+     symmetric? : % -> Boolean
+     symmetric? x ==
+       m ^= n => false
+       mr := minRowIndex x; mc := minColIndex x
+       for i in 0..(n - 1) repeat
+         for j in (i + 1)..(n - 1) repeat
+           qelt(x,mr + i,mc + j) ^= qelt(x,mr + j,mc + i) => return false
+       true
+
+     antisymmetric? : % -> Boolean
+     antisymmetric? x ==
+       m ^= n => false
+       mr := minRowIndex x; mc := minColIndex x
+       for i in 0..(n - 1) repeat
+         for j in i..(n - 1) repeat
+           qelt(x,mr + i,mc + j) ^= -qelt(x,mr + j,mc + i) =>
+             return false
+       true
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{RMATCAT.dotabb}
 "RMATCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RMATCAT"];
@@ -41772,6 +47308,7 @@ RectangularMatrixCategory(m,n,R,Row,Col): Category == Definition where
 "RMATCAT" -> "HOAGG"
 
 \end{chunk}
+
 \begin{chunk}{RMATCAT.dotfull}
 "RectangularMatrixCategory(a:NonNegativeInteger,b:NonNegativeInteger,c:Ring,d:DirectProductCategory(b,c),e:DirectProductCategory(a,c))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RMATCAT"];
@@ -41781,6 +47318,7 @@ RectangularMatrixCategory(m,n,R,Row,Col): Category == Definition where
   -> "HomogeneousAggregate(Ring)"
 
 \end{chunk}
+
 \begin{chunk}{RMATCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -41816,6 +47354,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{SquareFreeNormalizedTriangularSetCategory}{SNTSCAT}
 \pagepic{ps/v102squarefreenormalizedtriangularsetcategory.ps}{SNTSCAT}{0.45}
@@ -41933,6 +47472,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{SquareFreeNormalizedTriangularSetCategory.help}
 ====================================================================
 SquareFreeNormalizedTriangularSetCategory examples
@@ -42219,6 +47759,7 @@ SquareFreeNormalizedTriangularSetCategory(R:GcdDomain,_
         NormalizedTriangularSetCategory(R,E,V,P))
 
 \end{chunk}
+
 \begin{chunk}{SNTSCAT.dotabb}
 "SNTSCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SNTSCAT"];
@@ -42226,6 +47767,7 @@ SquareFreeNormalizedTriangularSetCategory(R:GcdDomain,_
 "SNTSCAT" -> "SFRTCAT"
 
 \end{chunk}
+
 \begin{chunk}{SNTSCAT.dotfull}
 "SquareFreeNormalizedTriangularSetCategory(a:GcdDomain,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SNTSCAT"];
@@ -42238,6 +47780,7 @@ SquareFreeNormalizedTriangularSetCategory(R:GcdDomain,_
 "NormalizedRegularTriangularSetCategory(a:GcdDomain,b:OrderedAbelianMonoidSup,c:OrderedSet,d:RecursivePolynomialCategory(a,b,c))"
 
 \end{chunk}
+
 \begin{chunk}{SNTSCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -42258,6 +47801,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{StringCategory}{STRICAT}
 \pagepic{ps/v102stringcategory.ps}{STRICAT}{0.75}
@@ -42375,6 +47919,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{StringCategory.help}
 ====================================================================
 StringCategory examples
@@ -42670,6 +48215,7 @@ StringCategory():Category == _
     ++ string(i) returns the decimal representation of i in a string
 
 \end{chunk}
+
 \begin{chunk}{STRICAT.dotabb}
 "STRICAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=STRICAT"];
@@ -42678,6 +48224,7 @@ StringCategory():Category == _
 "STRICAT" -> "SRAGG"
 
 \end{chunk}
+
 \begin{chunk}{STRICAT.dotfull}
 "StringCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=STRICAT"];
@@ -42686,6 +48233,7 @@ StringCategory():Category == _
 "StringCategory()" -> "StringAggregate()"
 
 \end{chunk}
+
 \begin{chunk}{STRICAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -42723,6 +48271,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{UnivariateSkewPolynomialCategory}{OREPCAT}
 \pagepic{ps/v102univariateskewpolynomialcategory.ps}{OREPCAT}{0.55}
@@ -42796,6 +48345,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{UnivariateSkewPolynomialCategory.help}
 ====================================================================
 UnivariateSkewPolynomialCategory examples
@@ -43216,6 +48766,157 @@ UnivariateSkewPolynomialCategory(R:Ring):
           [a, u0, v0, u * a0]
 
 \end{chunk}
+
+\begin{chunk}{COQ OREPCAT}
+(* category OREPCAT *)
+(*
+This is the category of univariate skew polynomials over an Ore
+coefficient ring.
+
+The multiplication is given by x a = \sigma(a) x + \delta a
+
+      coerce : R -> %
+      coerce(x:R):% == monomial(x, 0)
+ 
+      coefficients : % -> List(R)
+      coefficients l ==
+        ans:List(R) := empty()
+        while l ^= 0 repeat
+          ans := concat(leadingCoefficient l, ans)
+          l   := reductum l
+        ans
+ 
+      ?*? : (R,%) -> %
+      a:R * y:% ==
+        z:% := 0
+        while y ^= 0 repeat
+          z := z + monomial(a * leadingCoefficient y, degree y)
+          y := reductum y
+        z
+ 
+      retractIfCan : % -> Union(R,"failed")
+      retractIfCan(x:%):Union(R, "failed") ==
+        zero? x or zero? degree x => leadingCoefficient x
+        "failed"
+ 
+      if R has IntegralDomain then
+
+        exquo : (%,R) -> Union(%,"failed")
+        l exquo a ==
+          ans:% := 0
+          while l ^= 0 repeat
+            (u := (leadingCoefficient(l) exquo a)) case "failed" =>
+               return "failed"
+            ans := ans + monomial(u::R, degree l)
+            l   := reductum l
+          ans
+ 
+      if R has GcdDomain then
+
+        content : % -> R
+        content l == gcd coefficients l
+
+        primitivePart : % -> %
+        primitivePart l == (l exquo content l)::%
+ 
+      if R has Field then
+ 
+        leftQuotient : (%,%) -> %
+        leftQuotient(a, b) == leftDivide(a,b).quotient
+
+        leftRemainder : (%,%) -> %
+        leftRemainder(a, b) == leftDivide(a,b).remainder
+
+        leftExtendedGcd : (%,%) -> Record(coef1: %,coef2: %,generator: %)
+        leftExtendedGcd(a, b) == extended(a, b, leftEEA)
+
+        rightLcm : (%,%) -> %
+        rightLcm(a, b) == nclcm(a, b, leftEEA)
+
+        rightQuotient : (%,%) -> %
+        rightQuotient(a, b) == rightDivide(a,b).quotient
+
+        rightRemainder : (%,%) -> %
+        rightRemainder(a, b) == rightDivide(a,b).remainder
+
+        rightExtendedGcd : (%,%) -> Record(coef1: %,coef2: %,generator: %)
+        rightExtendedGcd(a, b) == extended(a, b, rightEEA)
+
+        leftLcm : (%,%) -> %
+        leftLcm(a, b) == nclcm(a, b, rightEEA)
+
+        leftExactQuotient : (%,%) -> Union(%,"failed")
+        leftExactQuotient(a, b) == exactQuotient leftDivide(a, b)
+
+        rightExactQuotient : (%,%) -> Union(%,"failed")
+        rightExactQuotient(a, b) == exactQuotient rightDivide(a, b)
+
+        rightGcd : (%,%) -> %
+        rightGcd(a, b) == ncgcd(a, b, rightRemainder)
+
+        leftGcd : (%,%) -> %
+        leftGcd(a, b) == ncgcd(a, b, leftRemainder)
+
+        exactQuotient: Record(quotient:%, remainder:%) -> Union(%, "failed")
+        exactQuotient qr == (zero?(qr.remainder) => qr.quotient; "failed")
+ 
+        -- returns [g = leftGcd(a, b), c, d, l = rightLcm(a, b)]
+        -- such that g := a c + b d
+        leftEEA:  (%, %) -> Record(gcd:%, coef1:%, coef2:%, lcm:%)
+        leftEEA(a, b) ==
+          a0 := a
+          u0:% := v:% := 1
+          v0:% := u:% := 0
+          while b ^= 0 repeat
+            qr     := leftDivide(a, b)
+            (a, b) := (b, qr.remainder)
+            (u0, u):= (u, u0 - u * qr.quotient)
+            (v0, v):= (v, v0 - v * qr.quotient)
+          [a, u0, v0, a0 * u]
+ 
+        ncgcd: (%, %, (%, %) -> %) -> %
+        ncgcd(a, b, ncrem) ==
+          zero? a => b
+          zero? b => a
+          degree a < degree b => ncgcd(b, a, ncrem)
+          while b ^= 0 repeat (a, b) := (b, ncrem(a, b))
+          a
+ 
+        extended: (%, %, (%, %) -> Record(gcd:%, coef1:%, coef2:%, lcm:%)) ->
+                                        Record(coef1:%, coef2:%, generator:%)
+        extended(a, b, eea) ==
+          zero? a => [0, 1, b]
+          zero? b => [1, 0, a]
+          degree a < degree b =>
+            rec := eea(b, a)
+            [rec.coef2, rec.coef1, rec.gcd]
+          rec := eea(a, b)
+          [rec.coef1, rec.coef2, rec.gcd]
+ 
+        nclcm: (%, %, (%, %) -> Record(gcd:%, coef1:%, coef2:%, lcm:%)) -> %
+        nclcm(a, b, eea) ==
+          zero? a or zero? b => 0
+          degree a < degree b => nclcm(b, a, eea)
+          rec := eea(a, b)
+          rec.lcm
+ 
+        -- returns [g = rightGcd(a, b), c, d, l = leftLcm(a, b)]
+        -- such that g := a c + b d
+        rightEEA: (%, %) -> Record(gcd:%, coef1:%, coef2:%, lcm:%)
+        rightEEA(a, b) ==
+          a0 := a
+          u0:% := v:% := 1
+          v0:% := u:% := 0
+          while b ^= 0 repeat
+            qr     := rightDivide(a, b)
+            (a, b) := (b, qr.remainder)
+            (u0, u):= (u, u0 - qr.quotient * u)
+            (v0, v):= (v, v0 - qr.quotient * v)
+          [a, u0, v0, u * a0]
+*)
+
+\end{chunk}
+
 \begin{chunk}{OREPCAT.dotabb}
 "OREPCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OREPCAT"];
@@ -43224,6 +48925,7 @@ UnivariateSkewPolynomialCategory(R:Ring):
 "OREPCAT" -> "RING"
 
 \end{chunk}
+
 \begin{chunk}{OREPCAT.dotfull}
 "UnivariateSkewPolynomialCategory(R:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OREPCAT"];
@@ -43235,6 +48937,7 @@ UnivariateSkewPolynomialCategory(R:Ring):
   -> "Ring()"
 
 \end{chunk}
+
 \begin{chunk}{OREPCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -43303,6 +49006,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{XAlgebra}{XALG}
 \pagepic{ps/v102xalgebra.ps}{XALG}{0.70}
@@ -43345,6 +49049,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{XAlgebra.help}
 ====================================================================
 XAlgebra examples
@@ -43389,7 +49094,6 @@ o )show XAlgebra
 
 \end{tabular}
 
-
 {\bf Attributes Exported:}
 \begin{itemize}
 \item {\bf \cross{XALG}{unitsKnown}}
@@ -43460,6 +49164,7 @@ XAlgebra(R: Ring): Category ==
     if R has CommutativeRing then Algebra(R)
 
 \end{chunk}
+
 \begin{chunk}{XALG.dotabb}
 "XALG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=XALG"];
@@ -43467,6 +49172,7 @@ XAlgebra(R: Ring): Category ==
 "XALG" -> "RING"
 
 \end{chunk}
+
 \begin{chunk}{XALG.dotfull}
 "XAlgebra(a:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=XALG"];
@@ -43474,6 +49180,7 @@ XAlgebra(R: Ring): Category ==
 "XAlgebra(a:Ring)" -> "BiModule(a:Ring,b:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{XALG.dotpic}
 digraph pic {
  fontsize=10;
@@ -43523,6 +49230,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 10}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Algebra}{ALGEBRA}
@@ -43566,6 +49274,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Algebra.help}
 ====================================================================
 Algebra examples
@@ -43694,6 +49403,24 @@ Algebra(R:CommutativeRing): Category ==
   coerce(x:R):% == x * 1$%
 
 \end{chunk}
+
+\begin{chunk}{COQ ALGEBRA}
+(* category ALGEBRA *)
+(*
+Axioms
+  (b+c)::% = (b::%) + (c::%)
+  (b*c)::% = (b::%) * (c::%)
+  (1::R)::% = 1::%
+  b*x = (b::%)*x
+  r*(a*b) = (r*a)*b = a*(r*b)
+
+  coerce : R -> %
+  coerce(x:R):% == x * 1$%
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ALGEBRA.dotabb}
 "ALGEBRA"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ALGEBRA"];
@@ -43701,6 +49428,7 @@ Algebra(R:CommutativeRing): Category ==
 "ALGEBRA" -> "MODULE"
 
 \end{chunk}
+
 \begin{chunk}{ALGEBRA.dotfull}
 "Algebra(a:CommutativeRing)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ALGEBRA"];
@@ -43783,6 +49511,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{DifferentialExtension}{DIFEXT}
 \pagepic{ps/v102differentialextension.ps}{DIFEXT}{0.65}
@@ -43838,6 +49567,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{DifferentialExtension.help}
 ====================================================================
 DifferentialExtension examples
@@ -44001,6 +49731,37 @@ DifferentialExtension(R:Ring): Category == Ring with
         differentiate(x, s +-> differentiate(s, v)$R)
 
 \end{chunk}
+
+\begin{chunk}{COQ DIFEXT}
+(* category DIFEXT *)
+(*
+
+    differentiate : (%,(R -> R),NonNegativeInteger) -> %
+    differentiate(x:%, derivation: R -> R, n:NonNegativeInteger):% ==
+      for i in 1..n repeat x := differentiate(x, derivation)
+      x
+
+    D : (%,(R -> R)) -> %
+    D(x:%, derivation: R -> R) == differentiate(x, derivation)
+
+    D : (%,(R -> R),NonNegativeInteger) -> %
+    D(x:%, derivation: R -> R, n:NonNegativeInteger) ==
+            differentiate(x, derivation, n)
+
+    if R has DifferentialRing then
+
+      differentiate : % -> %
+      differentiate x == differentiate(x, differentiate$R)
+
+    if R has PartialDifferentialRing Symbol then
+
+      differentiate : (%,Symbol) -> %
+      differentiate(x:%, v:Symbol):% ==
+        differentiate(x, s +-> differentiate(s, v)$R)
+*)
+
+\end{chunk}
+
 \begin{chunk}{DIFEXT.dotabb}
 "DIFEXT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DIFEXT"];
@@ -44009,6 +49770,7 @@ DifferentialExtension(R:Ring): Category == Ring with
 "DIFEXT" -> "PDRING"
 
 \end{chunk}
+
 \begin{chunk}{DIFEXT.dotfull}
 "DifferentialExtension(a:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DIFEXT"];
@@ -44027,6 +49789,7 @@ DifferentialExtension(R:Ring): Category == Ring with
   "DifferentialExtension(a:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{DIFEXT.dotpic}
 digraph pic {
  fontsize=10;
@@ -44070,6 +49833,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FullyLinearlyExplicitRingOver}{FLINEXP}
 \pagepic{ps/v102fullylinearlyexplicitringover.ps}{FLINEXP}{1.00}
@@ -44115,6 +49879,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FullyLinearlyExplicitRingOver.help}
 ====================================================================
 FullyLinearlyExplicitRingOver examples
@@ -44237,12 +50002,14 @@ FullyLinearlyExplicitRingOver(R:Ring):Category ==
           reducedSystem(rec.mat, rec.vec)
 
 \end{chunk}
+
 \begin{chunk}{FLINEXP.dotabb}
 "FLINEXP"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FLINEXP"];
 "FLINEXP" -> "LINEXP"
 
 \end{chunk}
+
 \begin{chunk}{FLINEXP.dotfull}
 "FullyLinearlyExplicitRingOver(a:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FLINEXP"];
@@ -44260,6 +50027,7 @@ FullyLinearlyExplicitRingOver(R:Ring):Category ==
     "FullyLinearlyExplicitRingOver(a:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{FLINEXP.dotpic}
 digraph pic {
  fontsize=10;
@@ -44306,6 +50074,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{LieAlgebra}{LIECAT}
 \pagepic{ps/v102liealgebra.ps}{LIECAT}{1.00}
@@ -44343,6 +50112,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{LieAlgebra.help}
 ====================================================================
 LieAlgebra examples
@@ -44450,18 +50220,29 @@ LieAlgebra(R: CommutativeRing): Category ==  Module(R) with
     if R has Field then x / r == inv(r)$R * x
 
 \end{chunk}
+
+\begin{chunk}{COQ LIECAT}
+(* category LIECAT *)
+(*
+    if R has Field then x / r == inv(r)$R * x
+*)
+
+\end{chunk}
+
 \begin{chunk}{LIECAT.dotabb}
 "LIECAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LIECAT"];
 "LIECAT" -> "MODULE"
 
 \end{chunk}
+
 \begin{chunk}{LIECAT.dotfull}
 "LieAlgebra(a:CommutativeRing)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LIECAT"];
 "LieAlgebra(a:CommutativeRing)" -> "Module(a:CommutativeRing)"
 
 \end{chunk}
+
 \begin{chunk}{LIECAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -44498,6 +50279,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{LinearOrdinaryDifferentialOperatorCategory}{LODOCAT}
 \pagepic{ps/v102linearordinarydifferentialoperatorcategory.ps}{LODOCAT}{0.50}
@@ -44576,6 +50358,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{LinearOrdinaryDifferentialOperatorCategory.help}
 ====================================================================
 LinearOrdinaryDifferentialOperatorCategory examples
@@ -44820,6 +50603,37 @@ LinearOrdinaryDifferentialOperatorCategory(A:Ring): Category ==
         if A has Field then symmetricSquare l == symmetricPower(l, 2)
 
 \end{chunk}
+
+\begin{chunk}{COQ LODOCAT}
+(* category LODOCAT *)
+(*
+Multiplication of operators corresponds to functional composition:
+(L1 * L2).(f) = L1 L2 f
+
+        D : () -> %
+        D() == monomial(1, 1)
+
+        m1monom: NonNegativeInteger -> %
+        m1monom n ==
+          a:A := (odd? n => -1; 1)
+          monomial(a, n)
+
+        adjoint : % -> %
+        adjoint a ==
+          ans:% := 0
+          while a ^= 0 repeat
+            ans := ans + m1monom(degree a) * leadingCoefficient(a)::%
+            a   := reductum a
+          ans
+
+        if A has Field then 
+
+          symmetricSquare : % -> %
+          symmetricSquare l == symmetricPower(l, 2)
+*)
+
+\end{chunk}
+
 \begin{chunk}{LODOCAT.dotabb}
 "LODOCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LODOCAT"];
@@ -44827,6 +50641,7 @@ LinearOrdinaryDifferentialOperatorCategory(A:Ring): Category ==
 "LODOCAT" -> "OREPCAT"
 
 \end{chunk}
+
 \begin{chunk}{LODOCAT.dotfull}
 "LinearOrdinaryDifferentialOperatorCategory(a:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LODOCAT"];
@@ -44836,6 +50651,7 @@ LinearOrdinaryDifferentialOperatorCategory(A:Ring): Category ==
   -> "UnivariateSkewPolynomialCategory(R:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{LODOCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -44918,6 +50734,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{NonAssociativeAlgebra}{NAALG}
 \pagepic{ps/v102nonassociativealgebra.ps}{NAALG}{0.75}
@@ -44960,6 +50777,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{NonAssociativeAlgebra.help}
 ====================================================================
 NonAssociativeAlgebra examples
@@ -45074,12 +50892,27 @@ NonAssociativeAlgebra(R:CommutativeRing): Category == _
       ++ and \spad{a} for \spad{n=1}.
   add
     plenaryPower(a,n) ==
---      one? n => a
       ( n = 1 ) => a
       n1 : PositiveInteger := (n-1)::NonNegativeInteger::PositiveInteger
       plenaryPower(a,n1) * plenaryPower(a,n1)
 
 \end{chunk}
+
+\begin{chunk}{COQ NAALG}
+(* category NAALG *)
+(*
+Axioms
+  r*(a*b) = (r*a)*b = a*(r*b)
+
+    plenaryPower : (%,PositiveInteger) -> %
+    plenaryPower(a,n) ==
+      ( n = 1 ) => a
+      n1 : PositiveInteger := (n-1)::NonNegativeInteger::PositiveInteger
+      plenaryPower(a,n1) * plenaryPower(a,n1)
+*)
+
+\end{chunk}
+
 \begin{chunk}{NAALG.dotabb}
 "NAALG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=NAALG"];
@@ -45087,6 +50920,7 @@ NonAssociativeAlgebra(R:CommutativeRing): Category == _
 "NAALG" -> "MODULE"
 
 \end{chunk}
+
 \begin{chunk}{NAALG.dotfull}
 "NonAssociativeAlgebra(a:CommutativeRing)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=NAALG"];
@@ -45094,6 +50928,7 @@ NonAssociativeAlgebra(R:CommutativeRing): Category == _
 "NonAssociativeAlgebra(a:CommutativeRing)" -> "Module(a:CommutativeRing)"
 
 \end{chunk}
+
 \begin{chunk}{NAALG.dotpic}
 digraph pic {
  fontsize=10;
@@ -45141,6 +50976,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{VectorSpace}{VSPACE}
 \pagepic{ps/v102vectorspace.ps}{VSPACE}{1.00}
@@ -45178,6 +51014,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{VectorSpace.help}
 ====================================================================
 VectorSpace examples
@@ -45267,18 +51104,31 @@ VectorSpace(S:Field): Category ==  Module(S) with
     (v:% / s:S):% == inv(s) * v
 
 \end{chunk}
+
+\begin{chunk}{COQ VSPACE}
+(* category VSPACE *)
+(*
+    ?/? : (%,S) -> %
+    (v:% / s:S):% == inv(s) * v
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{VSPACE.dotabb}
 "VSPACE"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=VSPACE"];
 "VSPACE" -> "MODULE"
 
 \end{chunk}
+
 \begin{chunk}{VSPACE.dotfull}
 "VectorSpace(a:Field)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=VSPACE"];
 "VectorSpace(a:Field)" -> "Module(Field)"
 
 \end{chunk}
+
 \begin{chunk}{VSPACE.dotpic}
 digraph pic {
  fontsize=10;
@@ -45318,6 +51168,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{XFreeAlgebra}{XFALG}
 \pagepic{ps/v102xfreealgebra.ps}{XFALG}{0.50}
@@ -45377,6 +51228,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{XFreeAlgebra.help}
 ====================================================================
 XFreeAlgebra examples
@@ -45617,6 +51469,7 @@ XFreeAlgebra(vl:OrderedSet,R:Ring):Category == Catdef where
        if R has noZeroDivisors then noZeroDivisors
 
 \end{chunk}
+
 \begin{chunk}{XFALG.dotabb}
 "XFALG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=XFALG"];
@@ -45625,6 +51478,7 @@ XFreeAlgebra(vl:OrderedSet,R:Ring):Category == Catdef where
 "XFALG" -> "XALG"
 
 \end{chunk}
+
 \begin{chunk}{XFALG.dotfull}
 "XFreeAlgebra(a:OrderedSet,b:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=XFALG"];
@@ -45634,6 +51488,7 @@ XFreeAlgebra(vl:OrderedSet,R:Ring):Category == Catdef where
     "RetractableTo(OrderedFreeMonoid(OrderedSet))"
 
 \end{chunk}
+
 \begin{chunk}{XFALG.dotpic}
 digraph pic {
  fontsize=10;
@@ -45699,6 +51554,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 11}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{DirectProductCategory}{DIRPCAT}
@@ -45824,6 +51680,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{DirectProductCategory.help}
 ====================================================================
 DirectProductCategory examples
@@ -46259,6 +52116,61 @@ DirectProductCategory(dim:NonNegativeInteger, R:Type): Category ==
         dimension() == dim::CardinalNumber
  
 \end{chunk}
+
+\begin{chunk}{COQ DIRPCAT}
+(* category DIRPCAT *)
+(*
+      if R has Ring then
+ 
+        coerce : Integer -> %
+        coerce(n:Integer):% == n::R::%
+
+        characteristic : () -> NonNegativeInteger
+        characteristic() == characteristic()$R
+
+        differentiate : (%,(R -> R)) -> %
+        differentiate(z:%, d:R -> R) == map(d, z)
+ 
+        equation2R: Vector % -> Matrix R
+        equation2R v ==
+          ans:Matrix(R) := new(dim, #v, 0)
+          for i in minRowIndex ans .. maxRowIndex ans repeat
+            for j in minColIndex ans .. maxColIndex ans repeat
+              qsetelt_!(ans, i, j, qelt(qelt(v, j), i))
+          ans
+ 
+        reducedSystem : Matrix(%) -> Matrix(R)
+        reducedSystem(m:Matrix %):Matrix(R) ==
+          empty? m => new(0, 0, 0)
+          reduce(vertConcat, [equation2R row(m, i)
+                 for i in minRowIndex m .. maxRowIndex m])$List(Matrix R)
+ 
+        reducedSystem : (Matrix(%),Vector(%)) ->
+          Record(mat: Matrix(R),vec: Vector(R))
+        reducedSystem(m:Matrix %, v:Vector %):
+          Record(mat:Matrix R, vec:Vector R) ==
+            vh:Vector(R) :=
+              empty? v => empty()
+              rh := reducedSystem(v::Matrix %)@Matrix(R)
+              column(rh, minColIndex rh)
+            [reducedSystem(m)@Matrix(R), vh]
+ 
+      if R has Finite then
+
+        size : () -> NonNegativeInteger
+        size == size$R ** dim
+ 
+      if R has Field then
+
+        ?/? : (%,R) -> %
+        x / b       == x * inv b
+
+        dimension : () -> CardinalNumber
+        dimension() == dim::CardinalNumber
+*)
+
+\end{chunk}
+
 \begin{chunk}{DIRPCAT.dotabb}
 "DIRPCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DIRPCAT"];
@@ -46273,6 +52185,7 @@ DirectProductCategory(dim:NonNegativeInteger, R:Type): Category ==
 "DIRPCAT" -> "OAMONS"
 
 \end{chunk}
+
 \begin{chunk}{DIRPCAT.dotfull}
 "DirectProductCategory(a:NonNegativeInteger,b:Type)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DIRPCAT"];
@@ -46296,6 +52209,7 @@ DirectProductCategory(dim:NonNegativeInteger, R:Type): Category ==
   -> "OrderedAbelianMonoidSup()"
 
 \end{chunk}
+
 \begin{chunk}{DIRPCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -46326,6 +52240,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{DivisionRing}{DIVRING}
 \pagepic{ps/v102divisionring.ps}{DIVRING}{0.65}
@@ -46370,6 +52285,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{DivisionRing.help}
 ====================================================================
 DivisionRing examples
@@ -46511,6 +52427,35 @@ DivisionRing(): Category ==
       q:Fraction(Integer) * x:% == numer(q) * inv(denom(q)::%) * x
 
 \end{chunk}
+
+\begin{chunk}{COQ DIVRING}
+(* category DIVRING *)
+(*
+      n: Integer
+      x: %
+
+      ?^? : (%,Integer) -> %
+      _^(x:%, n:Integer):% == x ** n
+
+      import RepeatedSquaring(%)
+
+      ?**? : (%,Integer) -> %
+      x ** n: Integer ==
+         zero? n => 1
+         zero? x =>
+            n<0 => error "division by zero"
+            x
+         n<0 =>
+            expt(inv x,(-n) pretend PositiveInteger)
+         expt(x,n pretend PositiveInteger)
+
+      ?*? : (Fraction(Integer),%) -> %
+      q:Fraction(Integer) * x:% == numer(q) * inv(denom(q)::%) * x
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{DIVRING.dotabb}
 "DIVRING"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DIVRING"];
@@ -46518,6 +52463,7 @@ DivisionRing(): Category ==
 "DIVRING" -> "ALGEBRA"
 
 \end{chunk}
+
 \begin{chunk}{DIVRING.dotfull}
 "DivisionRing()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DIVRING"];
@@ -46526,6 +52472,7 @@ DivisionRing(): Category ==
 "DivisionRing()" -> "RepeatedSquaring(DivisionRing)"
 
 \end{chunk}
+
 \begin{chunk}{DIVRING.dotpic}
 digraph pic {
  fontsize=10;
@@ -46568,6 +52515,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FiniteRankNonAssociativeAlgebra}{FINAALG}
 \pagepic{ps/v102finiteranknonassociativealgebra.ps}{FINAALG}{0.80}
@@ -47531,12 +53479,454 @@ FiniteRankNonAssociativeAlgebra(R:CommutativeRing):
        [parts coordinates(b(i+m)*x,b) for i in 1..rank()]$List(List R)
 
 \end{chunk}
+
+\begin{chunk}{COQ FINAALG}
+(* category FINAALG *)
+(*
+    V  ==> Vector
+    M  ==> Matrix
+    REC  ==> Record(particular: Union(V R,"failed"),basis: List V R)
+    LSMP ==> LinearSystemMatrixPackage(R,V R,V R, M R)
+    SUP ==>  SparseUnivariatePolynomial
+    NNI ==>  NonNegativeInteger
+
+    -- next 2 functions: use a general characteristicPolynomial
+    leftCharacteristicPolynomial : % -> SparseUnivariatePolynomial(R)
+    leftCharacteristicPolynomial a ==
+       n := rank()$%
+       ma : Matrix R := leftRegularRepresentation(a,someBasis()$%)
+       mb : Matrix SUP R := zero(n,n)
+       for i in 1..n repeat
+         for j in 1..n repeat
+           mb(i,j):=
+             i=j => monomial(ma(i,j),0)$SUP(R) - monomial(1,1)$SUP(R)
+             monomial(ma(i,j),1)$SUP(R)
+       determinant mb
+
+    rightCharacteristicPolynomial : % -> SparseUnivariatePolynomial(R)
+    rightCharacteristicPolynomial a ==
+       n := rank()$%
+       ma : Matrix R := rightRegularRepresentation(a,someBasis()$%)
+       mb : Matrix SUP R := zero(n,n)
+       for i in 1..n repeat
+         for j in 1..n repeat
+           mb(i,j):=
+             i=j => monomial(ma(i,j),0)$SUP(R) - monomial(1,1)$SUP(R)
+             monomial(ma(i,j),1)$SUP(R)
+       determinant mb
+
+    leftTrace : % -> R
+    leftTrace a ==
+      t : R := 0
+      ma : Matrix R := leftRegularRepresentation(a,someBasis()$%)
+      for i in 1..rank()$% repeat
+        t := t + elt(ma,i,i)
+      t
+
+    rightTrace : % -> R
+    rightTrace a ==
+      t : R := 0
+      ma : Matrix R := rightRegularRepresentation(a,someBasis()$%)
+      for i in 1..rank()$% repeat
+        t := t + elt(ma,i,i)
+      t
+
+    leftNorm : % -> R
+    leftNorm a == determinant leftRegularRepresentation(a,someBasis()$%)
+
+    rightNorm : % -> R
+    rightNorm a == determinant rightRegularRepresentation(a,someBasis()$%)
+
+    antiAssociative? : () -> Boolean
+    antiAssociative?() ==
+      b := someBasis()
+      n := rank()
+      for i in 1..n repeat
+        for j in 1..n repeat
+          for k in 1..n repeat
+            not zero? ( (b.i*b.j)*b.k + b.i*(b.j*b.k) )  =>
+              messagePrint("algebra is not anti-associative")$OutputForm
+              return false
+      messagePrint("algebra is anti-associative")$OutputForm
+      true
+
+    jordanAdmissible? : () -> Boolean
+    jordanAdmissible?() ==
+      b := someBasis()
+      n := rank()
+      recip(2 * 1$R) case "failed" =>
+        messagePrint("this algebra is not Jordan admissible, " _
+         "as 2 is not invertible in the ground ring")$OutputForm
+        false
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         for l in 1..n repeat
+           not zero? ( _
+             antiCommutator(antiCommutator(b.i,b.j),_
+                            antiCommutator(b.l,b.k)) + _
+             antiCommutator(antiCommutator(b.l,b.j),_
+                            antiCommutator(b.k,b.i)) + _
+             antiCommutator(antiCommutator(b.k,b.j),_
+                            antiCommutator(b.i,b.l))   _
+                      ) =>
+               messagePrint(_
+                         "this algebra is not Jordan admissible")$OutputForm
+               return false
+      messagePrint("this algebra is Jordan admissible")$OutputForm
+      true
+
+    lieAdmissible? : () -> Boolean
+    lieAdmissible?() ==
+      n := rank()
+      b := someBasis()
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+          not zero? (commutator(commutator(b.i,b.j),b.k) _
+                  + commutator(commutator(b.j,b.k),b.i) _
+                  + commutator(commutator(b.k,b.i),b.j))   =>
+            messagePrint("this algebra is not Lie admissible")$OutputForm
+            return false
+      messagePrint("this algebra is Lie admissible")$OutputForm
+      true
+
+    structuralConstants : Vector(%) -> Vector(Matrix(R))
+    structuralConstants b ==
+      --n := rank()
+      -- be careful with the possibility that b is not a basis
+      m : NonNegativeInteger := (maxIndex b) :: NonNegativeInteger
+      sC : Vector Matrix R := [new(m,m,0$R) for k in 1..m]
+      for i in 1..m repeat
+        for j in 1..m repeat
+          covec : Vector R := coordinates(b.i * b.j, b)
+          for k in 1..m repeat
+             setelt( sC.k, i, j, covec.k )
+      sC
+
+    if R has IntegralDomain then
+
+      leftRecip : % -> Union(%,"failed")
+      leftRecip x ==
+        zero? x => "failed"
+        lu := leftUnit()
+        lu case "failed" => "failed"
+        b := someBasis()
+        xx : % := (lu :: %)
+        k  : PositiveInteger := 1
+        cond : Matrix R := coordinates(xx,b) :: Matrix(R)
+        listOfPowers : List % := [xx]
+        while rank(cond) = k repeat
+          k := k+1
+          xx := xx*x
+          listOfPowers := cons(xx,listOfPowers)
+          cond := horizConcat(cond, coordinates(xx,b) :: Matrix(R) )
+        vectorOfCoef : Vector R := (nullSpace(cond)$Matrix(R)).first
+        invC := recip vectorOfCoef.1
+        invC case "failed" => "failed"
+        invCR : R :=  - (invC :: R)
+        reduce(_+,[(invCR*vectorOfCoef.i)*power for i in _
+         2..maxIndex vectorOfCoef for power in reverse listOfPowers])
+
+      rightRecip : % -> Union(%,"failed")
+      rightRecip x ==
+        zero? x => "failed"
+        ru := rightUnit()
+        ru case "failed" => "failed"
+        b := someBasis()
+        xx : % := (ru :: %)
+        k  : PositiveInteger := 1
+        cond : Matrix R := coordinates(xx,b) :: Matrix(R)
+        listOfPowers : List % := [xx]
+        while rank(cond) = k repeat
+          k := k+1
+          xx := x*xx
+          listOfPowers := cons(xx,listOfPowers)
+          cond := horizConcat(cond, coordinates(xx,b) :: Matrix(R) )
+        vectorOfCoef : Vector R := (nullSpace(cond)$Matrix(R)).first
+        invC := recip vectorOfCoef.1
+        invC case "failed" => "failed"
+        invCR : R :=  - (invC :: R)
+        reduce(_+,[(invCR*vectorOfCoef.i)*power for i in _
+         2..maxIndex vectorOfCoef for power in reverse listOfPowers])
+
+      recip : % -> Union(%,"failed")
+      recip x ==
+        lrx := leftRecip x
+        lrx case "failed" => "failed"
+        rrx := rightRecip x
+        rrx case "failed" => "failed"
+        (lrx :: %) ^= (rrx :: %)  => "failed"
+        lrx :: %
+
+      leftMinimalPolynomial : % -> SparseUnivariatePolynomial(R)
+      leftMinimalPolynomial x ==
+        zero? x =>  monomial(1$R,1)$(SparseUnivariatePolynomial R)
+        b := someBasis()
+        xx : % := x
+        k  : PositiveInteger := 1
+        cond : Matrix R := coordinates(xx,b) :: Matrix(R)
+        while rank(cond) = k repeat
+          k := k+1
+          xx := x*xx
+          cond := horizConcat(cond, coordinates(xx,b) :: Matrix(R) )
+        vectorOfCoef : Vector R := (nullSpace(cond)$Matrix(R)).first
+        res : SparseUnivariatePolynomial R := 0
+        for i in 1..k repeat
+          res:=res+monomial(vectorOfCoef.i,i)$(SparseUnivariatePolynomial R)
+        res
+
+      rightMinimalPolynomial : % -> SparseUnivariatePolynomial(R)
+      rightMinimalPolynomial x ==
+        zero? x =>  monomial(1$R,1)$(SparseUnivariatePolynomial R)
+        b := someBasis()
+        xx : % := x
+        k  : PositiveInteger := 1
+        cond : Matrix R := coordinates(xx,b) :: Matrix(R)
+        while rank(cond) = k repeat
+          k := k+1
+          xx := xx*x
+          cond := horizConcat(cond, coordinates(xx,b) :: Matrix(R) )
+        vectorOfCoef : Vector R := (nullSpace(cond)$Matrix(R)).first
+        res : SparseUnivariatePolynomial R := 0
+        for i in 1..k repeat
+          res:=res+monomial(vectorOfCoef.i,i)$(SparseUnivariatePolynomial R)
+        res
+
+      associatorDependence : () -> List(Vector(R))
+      associatorDependence() ==
+        n := rank()
+        b := someBasis()
+        cond : Matrix(R) := new(n**4,6,0$R)$Matrix(R)
+        z : Integer := 0
+        for i in 1..n repeat
+         for j in 1..n repeat
+          for k in 1..n repeat
+           a123 : Vector R := coordinates(associator(b.i,b.j,b.k),b)
+           a231 : Vector R := coordinates(associator(b.j,b.k,b.i),b)
+           a312 : Vector R := coordinates(associator(b.k,b.i,b.j),b)
+           a132 : Vector R := coordinates(associator(b.i,b.k,b.j),b)
+           a321 : Vector R := coordinates(associator(b.k,b.j,b.i),b)
+           a213 : Vector R := coordinates(associator(b.j,b.i,b.k),b)
+           for r in 1..n repeat
+            z:= z+1
+            setelt(cond,z,1,elt(a123,r))
+            setelt(cond,z,2,elt(a231,r))
+            setelt(cond,z,3,elt(a312,r))
+            setelt(cond,z,4,elt(a132,r))
+            setelt(cond,z,5,elt(a321,r))
+            setelt(cond,z,6,elt(a213,r))
+        nullSpace(cond)
+
+    jacobiIdentity? : () -> Boolean
+    jacobiIdentity?()  ==
+      n := rank()
+      b := someBasis()
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+          not zero? ((b.i*b.j)*b.k + (b.j*b.k)*b.i + (b.k*b.i)*b.j) =>
+            messagePrint("Jacobi identity does not hold")$OutputForm
+            return false
+      messagePrint("Jacobi identity holds")$OutputForm
+      true
+
+    lieAlgebra? : () -> Boolean
+    lieAlgebra?()  ==
+      not antiCommutative?() =>
+        messagePrint("this is not a Lie algebra")$OutputForm
+        false
+      not jacobiIdentity?() =>
+        messagePrint("this is not a Lie algebra")$OutputForm
+        false
+      messagePrint("this is a Lie algebra")$OutputForm
+      true
+
+    jordanAdmissible? : () -> Boolean
+    jordanAlgebra?()  ==
+      b := someBasis()
+      n := rank()
+      recip(2 * 1$R) case "failed" =>
+        messagePrint("this is not a Jordan algebra, as 2 is not " _
+         "invertible in the ground ring")$OutputForm
+        false
+      not commutative?() =>
+        messagePrint("this is not a Jordan algebra")$OutputForm
+        false
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         for l in 1..n repeat
+           not zero? (associator(b.i,b.j,b.l*b.k)+_
+               associator(b.l,b.j,b.k*b.i)+associator(b.k,b.j,b.i*b.l)) =>
+             messagePrint("not a Jordan algebra")$OutputForm
+             return false
+      messagePrint("this is a Jordan algebra")$OutputForm
+      true
+
+    noncommutativeJordanAlgebra? : () -> Boolean
+    noncommutativeJordanAlgebra?() ==
+      b := someBasis()
+      n := rank()
+      recip(2 * 1$R) case "failed" =>                             
+       messagePrint("this is not a noncommutative Jordan algebra,_
+ as 2 is not invertible in the ground ring")$OutputForm
+       false
+      not flexible?()$% =>
+       messagePrint("this is not a noncommutative Jordan algebra,_
+ as it is not flexible")$OutputForm
+       false
+      not jordanAdmissible?()$% =>
+       messagePrint("this is not a noncommutative Jordan algebra,_
+ as it is not Jordan admissible")$OutputForm
+       false
+      messagePrint("this is a noncommutative Jordan algebra")$OutputForm
+      true
+
+    antiCommutative? : () -> Boolean
+    antiCommutative?() ==
+      b := someBasis()
+      n := rank()
+      for i in 1..n repeat
+        for j in i..n repeat
+          not zero? (i=j => b.i*b.i; b.i*b.j + b.j*b.i) =>
+            messagePrint("algebra is not anti-commutative")$OutputForm
+            return false
+      messagePrint("algebra is anti-commutative")$OutputForm
+      true
+
+    commutative? : () -> Boolean
+    commutative?() ==
+      b := someBasis()
+      n := rank()
+      for i in 1..n repeat
+       for j in i+1..n repeat
+         not zero? commutator(b.i,b.j) =>
+           messagePrint("algebra is not commutative")$OutputForm
+           return false
+      messagePrint("algebra is commutative")$OutputForm
+      true
+
+    associative? : () -> Boolean
+    associative?() ==
+      b := someBasis()
+      n := rank()
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         not zero? associator(b.i,b.j,b.k) =>
+           messagePrint("algebra is not associative")$OutputForm
+           return false
+      messagePrint("algebra is associative")$OutputForm
+      true
+
+    leftAlternative? : () -> Boolean
+    leftAlternative?() ==
+      b := someBasis()
+      n := rank()
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         not zero? (associator(b.i,b.j,b.k) + associator(b.j,b.i,b.k)) =>
+           messagePrint("algebra is not left alternative")$OutputForm
+           return false
+      messagePrint("algebra satisfies 2*associator(a,a,b) = 0")$OutputForm
+      true
+
+    rightAlternative? : () -> Boolean
+    rightAlternative?() ==
+      b := someBasis()
+      n := rank()
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         not zero? (associator(b.i,b.j,b.k) + associator(b.i,b.k,b.j)) =>
+           messagePrint("algebra is not right alternative")$OutputForm
+           return false
+      messagePrint("algebra satisfies 2*associator(a,b,b) = 0")$OutputForm
+      true
+
+    flexible? : () -> Boolean
+    flexible?() ==
+      b := someBasis()
+      n := rank()
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         not zero? (associator(b.i,b.j,b.k) + associator(b.k,b.j,b.i)) =>
+           messagePrint("algebra is not flexible")$OutputForm
+           return false
+      messagePrint("algebra satisfies 2*associator(a,b,a) = 0")$OutputForm
+      true
+
+    alternative? : () -> Boolean
+    alternative?() ==
+      b := someBasis()
+      n := rank()
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         not zero? (associator(b.i,b.j,b.k) + associator(b.j,b.i,b.k)) =>
+           messagePrint("algebra is not alternative")$OutputForm
+           return false
+         not zero? (associator(b.i,b.j,b.k) + associator(b.i,b.k,b.j)) =>
+           messagePrint("algebra is not alternative")$OutputForm
+           return false
+      messagePrint("algebra satisfies 2*associator(a,b,b) = 0 " _
+                   "=  2*associator(a,a,b) = 0")$OutputForm
+      true
+
+    leftDiscriminant : Vector(%) -> R
+    leftDiscriminant v == determinant leftTraceMatrix v
+
+    rightDiscriminant : Vector(%) -> R
+    rightDiscriminant v == determinant rightTraceMatrix v
+
+    coordinates : (Vector(%),Vector(%)) -> Matrix(R)
+    coordinates(v:Vector %, b:Vector %) ==
+      m := new(#v, #b, 0)$Matrix(R)
+      for i in minIndex v .. maxIndex v for j in minRowIndex m .. repeat
+        setRow_!(m, j, coordinates(qelt(v, i), b))
+      m
+
+    represents : (Vector(R),Vector(%)) -> %
+    represents(v, b) ==
+      m := minIndex v - 1
+      reduce(_+,[v(i+m) * b(i+m) for i in 1..maxIndex b])
+
+    leftTraceMatrix : Vector(%) -> Matrix(R)
+    leftTraceMatrix v ==
+      matrix [[leftTrace(v.i*v.j) for j in minIndex v..maxIndex v]$List(R)
+               for i in minIndex v .. maxIndex v]$List(List R)
+
+    rightTraceMatrix : Vector(%) -> Matrix(R)
+    rightTraceMatrix v ==
+      matrix [[rightTrace(v.i*v.j) for j in minIndex v..maxIndex v]$List(R)
+               for i in minIndex v .. maxIndex v]$List(List R)
+
+    leftRegularRepresentation : (%,Vector(%)) -> Matrix(R)
+    leftRegularRepresentation(x, b) ==
+      m := minIndex b - 1
+      matrix
+       [parts coordinates(x*b(i+m),b) for i in 1..rank()]$List(List R)
+
+    rightRegularRepresentation : (%,Vector(%)) -> Matrix(R)
+    rightRegularRepresentation(x, b) ==
+      m := minIndex b - 1
+      matrix
+       [parts coordinates(b(i+m)*x,b) for i in 1..rank()]$List(List R)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FINAALG.dotabb}
 "FINAALG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FINAALG"];
 "FINAALG" -> "NAALG"
 
 \end{chunk}
+
 \begin{chunk}{FINAALG.dotfull}
 "FiniteRankNonAssociativeAlgebra(a:CommutativeRing)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FINAALG"];
@@ -47544,6 +53934,7 @@ FiniteRankNonAssociativeAlgebra(R:CommutativeRing):
     "NonAssociativeAlgebra(a:CommutativeRing)"
 
 \end{chunk}
+
 \begin{chunk}{FINAALG.dotpic}
 digraph pic {
  fontsize=10;
@@ -47595,6 +53986,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FreeLieAlgebra}{FLALG}
 \pagepic{ps/v102freeliealgebra.ps}{FLALG}{1.00}
@@ -47642,6 +54034,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FreeLieAlgebra.help}
 ====================================================================
 FreeLieAlgebra examples
@@ -47801,12 +54194,14 @@ FreeLieAlgebra(VarSet:OrderedSet, R:CommutativeRing) :Category == _
        ++ by \axiom{vi} in \axiom{p}.
 
 \end{chunk}
+
 \begin{chunk}{FLALG.dotabb}
 "FLALG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FLALG"];
 "FLALG" -> "LIECAT"
 
 \end{chunk}
+
 \begin{chunk}{FLALG.dotfull}
 "FreeLieAlgebra(a:OrderedSet,b:CommutativeRing)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FLALG"];
@@ -47814,6 +54209,7 @@ FreeLieAlgebra(VarSet:OrderedSet, R:CommutativeRing) :Category == _
    "LieAlgebra(a:CommutativeRing)"
 
 \end{chunk}
+
 \begin{chunk}{FLALG.dotpic}
 digraph pic {
  fontsize=10;
@@ -47854,6 +54250,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{IntegralDomain}{INTDOM}
 \pagepic{ps/v102integraldomain.ps}{INTDOM}{0.65}
@@ -47899,6 +54296,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{IntegralDomain.help}
 ====================================================================
 IntegralDomain examples
@@ -47917,8 +54315,6 @@ have zero divisors since
   | 0 0 | | 0 0 |   | 0 0 |
   +-   -+ +-   -+   +-   -+
 
-
-
 Conditional attributes:
   canonicalUnitNormal - the canonical field is the same for all associates
   canonicalsClosed    - the product of two canonicals is itself canonical
@@ -48106,6 +54502,60 @@ IntegralDomain(): Category ==
            true
 
 \end{chunk}
+
+\begin{chunk}{COQ INTDOM}
+(* category INTDOM *)
+(*
+Conditional attributes:
+  canonicalUnitNormal - the canonical field is the same for all associates
+  canonicalsClosed    - the product of two canonicals is itself canonical
+
+ Ring -> CommutativeRing -> IntegralDomain
+
+   1) (associative addition)        a + (b + c) = (a + b) + c 
+   2) (commutative addition)        a + b = b + a 
+   3) (associative multiplication)  a(bc) = (ab)c 
+   4) (distributive mulitplication) a(b + c) = ab + ac; (b + c)a = ba + ca
+   5) (equation solution)           a + x = b has a solution in R
+
+      x,y: %
+
+      UCA ==> Record(unit:%,canonical:%,associate:%)
+
+      if not (% has Field) then
+
+        unitNormal : % -> Record(unit: %,canonical: %,associate: %)
+        unitNormal(x) == [1$%,x,1$%]$UCA -- the non-canonical definition
+
+      unitCanonical : % -> %
+      unitCanonical(x) == unitNormal(x).canonical -- always true
+
+      recip : % -> Union(%,"failed")
+      recip(x) == if zero? x then "failed" else _exquo(1$%,x)
+
+      unit? : % -> Boolean
+      unit?(x) == (recip x case "failed" => false; true)
+
+      if % has canonicalUnitNormal then
+
+         associates? : (%,%) -> Boolean
+         associates?(x,y) ==
+           (unitNormal x).canonical = (unitNormal y).canonical
+
+       else
+
+         associates? : (%,%) -> Boolean
+         associates?(x,y) ==
+           zero? x => zero? y
+           zero? y => false
+           x exquo y case "failed" => false
+           y exquo x case "failed" => false
+           true
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{INTDOM.dotabb}
 "INTDOM"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=INTDOM"];
@@ -48114,6 +54564,7 @@ IntegralDomain(): Category ==
 "INTDOM" -> "ENTIRER"
 
 \end{chunk}
+
 \begin{chunk}{INTDOM.dotfull}
 "IntegralDomain()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=INTDOM"];
@@ -48122,6 +54573,7 @@ IntegralDomain(): Category ==
 "IntegralDomain()" -> "EntireRing()"
 
 \end{chunk}
+
 \begin{chunk}{INTDOM.dotpic}
 digraph pic {
  fontsize=10;
@@ -48157,6 +54609,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{MonogenicLinearOperator}{MLO}
 \pagepic{ps/v102monogeniclinearoperator.ps}{MLO}{0.60}
@@ -48204,6 +54657,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{MonogenicLinearOperator.help}
 ====================================================================
 MonogenicLinearOperator examples
@@ -48368,6 +54822,7 @@ MonogenicLinearOperator(R): Category == Defn where
             ++ the generating operator, \spad{monomial(1,1)}.
 
 \end{chunk}
+
 \begin{chunk}{MLO.dotabb}
 "MLO"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MLO"];
@@ -48376,6 +54831,7 @@ MonogenicLinearOperator(R): Category == Defn where
 "MLO" -> "ALGEBRA"
 
 \end{chunk}
+
 \begin{chunk}{MLO.dotfull}
 "MonogenicLinearOperator(a:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MLO"];
@@ -48384,6 +54840,7 @@ MonogenicLinearOperator(R): Category == Defn where
 "MonogenicLinearOperator(a:Ring)" -> "Algebra(a:CommutativeRing)"
 
 \end{chunk}
+
 \begin{chunk}{MLO.dotpic}
 digraph pic {
  fontsize=10;
@@ -48449,6 +54906,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OctonionCategory}{OC}
 \pagepic{ps/v102octonioncategory.ps}{OC}{1.00}
@@ -48526,6 +54984,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OctonionCategory.help}
 ====================================================================
 OctonionCategory examples
@@ -48869,7 +55328,6 @@ OctonionCategory(R: CommutativeRing): Category ==
              imagI(x),imagJ(x),imagK(x))
            z :=
              part := "i"::Symbol::OutputForm
---             one? imagi(x) => part
              (imagi(x) = 1) => part
              (imagi(x) :: OutputForm) * part
            zero? y => z
@@ -48880,7 +55338,6 @@ OctonionCategory(R: CommutativeRing): Category ==
              imagI(x),imagJ(x),imagK(x))
            z :=
              part := "j"::Symbol::OutputForm
---             one? imagj(x) => part
              (imagj(x) = 1) => part
              (imagj(x) :: OutputForm) * part
            zero? y => z
@@ -48891,7 +55348,6 @@ OctonionCategory(R: CommutativeRing): Category ==
              imagI(x),imagJ(x),imagK(x))
            z :=
              part := "k"::Symbol::OutputForm
---             one? imagk(x) => part
              (imagk(x) = 1) => part
              (imagk(x) :: OutputForm) * part
            zero? y => z
@@ -48902,7 +55358,6 @@ OctonionCategory(R: CommutativeRing): Category ==
              imagI(x),imagJ(x),imagK(x))
            z :=
              part := "E"::Symbol::OutputForm
---             one? imagE(x) => part
              (imagE(x) = 1) => part
              (imagE(x) :: OutputForm) * part
            zero? y => z
@@ -48912,7 +55367,6 @@ OctonionCategory(R: CommutativeRing): Category ==
            y := octon(0$R,0$R,0$R,0$R,0$R,0$R,imagJ(x),imagK(x))
            z :=
              part := "I"::Symbol::OutputForm
---             one? imagI(x) => part
              (imagI(x) = 1) => part
              (imagI(x) :: OutputForm) * part
            zero? y => z
@@ -48922,14 +55376,12 @@ OctonionCategory(R: CommutativeRing): Category ==
            y := octon(0$R,0$R,0$R,0$R,0$R,0$R,0$R,imagK(x))
            z :=
              part := "J"::Symbol::OutputForm
---             one? imagJ(x) => part
              (imagJ(x) = 1) => part
              (imagJ(x) :: OutputForm) * part
            zero? y => z
            z + (y :: OutputForm)
          -- we know that the real part,i,j,k,E,I,J parts are 0
          part := "K"::Symbol::OutputForm
---         one? imagK(x) => part
          (imagK(x) = 1) => part
          (imagK(x) :: OutputForm) * part
  
@@ -48983,6 +55435,227 @@ OctonionCategory(R: CommutativeRing): Category ==
          "failed"
 
 \end{chunk}
+
+\begin{chunk}{COQ OC}
+(* category OC *)
+(*
+
+     characteristic : () -> NonNegativeInteger
+     characteristic() == 
+       characteristic()$R
+
+     conjugate : % -> %
+     conjugate x ==
+       octon(real x, - imagi x, - imagj x, - imagk x, - imagE x,_
+       - imagI x, - imagJ x, - imagK x)
+
+     map : ((R -> R),%) -> %
+     map(fn, x)       ==
+       octon(fn real x,fn imagi x,fn imagj x,fn imagk x, fn imagE x,_
+       fn imagI x, fn imagJ x,fn imagK x)
+
+     norm : % -> R
+     norm x ==
+       real x * real x + imagi x * imagi x + _
+       imagj x * imagj x + imagk x * imagk x + _
+       imagE x * imagE x + imagI x * imagI x + _
+       imagJ x * imagJ x + imagK x * imagK x
+
+     ?=? : (%,%) -> Boolean
+     x = y ==
+       (real x = real y) and (imagi x = imagi y) and _
+       (imagj x = imagj y) and (imagk x = imagk y) and _
+       (imagE x = imagE y) and (imagI x = imagI y) and _
+       (imagJ x = imagJ y) and (imagK x = imagK y)
+
+     ?+? : (%,%) -> %
+     x + y ==
+       octon(real x + real y, imagi x + imagi y,_
+       imagj x + imagj y, imagk x + imagk y,_
+       imagE x + imagE y, imagI x + imagI y,_
+       imagJ x + imagJ y, imagK x + imagK y)
+
+     -? : % -> %
+     - x ==
+       octon(- real x, - imagi x, - imagj x, - imagk x,_
+       - imagE x, - imagI x, - imagJ x, - imagK x)
+
+     ?*? : (R,%) -> %
+     r:R * x:% ==
+       octon(r * real x, r * imagi x, r * imagj x, r * imagk x,_
+       r * imagE x, r * imagI x, r * imagJ x, r * imagK x)
+
+     ?*? : (Integer,%) -> %
+     n:Integer * x:%  ==
+       octon(n * real x, n * imagi x, n * imagj x, n * imagk x,_
+       n * imagE x, n * imagI x, n * imagJ x, n * imagK x)
+
+     coerce : R -> %
+     coerce(r:R) ==
+       octon(r,0$R,0$R,0$R,0$R,0$R,0$R,0$R)
+
+     coerce : Integer -> %
+     coerce(n:Integer)      ==
+       octon(n :: R,0$R,0$R,0$R,0$R,0$R,0$R,0$R)
+
+     zero? : % -> Boolean
+     zero? x ==
+       zero? real x and zero? imagi x and _
+       zero? imagj x and zero? imagk x and _
+       zero? imagE x and zero? imagI x and _
+       zero? imagJ x and zero? imagK x
+
+     retract : % -> R
+     retract(x):R ==
+       not (zero? imagi x and zero? imagj x and zero? imagk x and _
+       zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=>
+         error "Cannot retract octonion."
+       real x
+
+     rationalIfCan : % -> Union(Fraction(Integer),"failed")
+     retractIfCan(x):Union(R,"failed") ==
+       not (zero? imagi x and zero? imagj x and zero? imagk x and _
+       zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=>
+         "failed"
+       real x
+ 
+     coerce : % -> OutputForm
+     coerce(x:%):OutputForm ==
+         part,z : OutputForm
+         y : %
+         zero? x => (0$R) :: OutputForm
+         not zero?(real x) =>
+           y := octon(0$R,imagi(x),imagj(x),imagk(x),imagE(x),
+             imagI(x),imagJ(x),imagK(x))
+           zero? y => real(x) :: OutputForm
+           (real(x) :: OutputForm) + (y :: OutputForm)
+         -- we know that the real part is 0
+         not zero?(imagi(x)) =>
+           y := octon(0$R,0$R,imagj(x),imagk(x),imagE(x),
+             imagI(x),imagJ(x),imagK(x))
+           z :=
+             part := "i"::Symbol::OutputForm
+             (imagi(x) = 1) => part
+             (imagi(x) :: OutputForm) * part
+           zero? y => z
+           z + (y :: OutputForm)
+         -- we know that the real part and i part are 0
+         not zero?(imagj(x)) =>
+           y := octon(0$R,0$R,0$R,imagk(x),imagE(x),
+             imagI(x),imagJ(x),imagK(x))
+           z :=
+             part := "j"::Symbol::OutputForm
+             (imagj(x) = 1) => part
+             (imagj(x) :: OutputForm) * part
+           zero? y => z
+           z + (y :: OutputForm)
+         -- we know that the real part and i and j parts are 0
+         not zero?(imagk(x)) =>
+           y := octon(0$R,0$R,0$R,0$R,imagE(x),
+             imagI(x),imagJ(x),imagK(x))
+           z :=
+             part := "k"::Symbol::OutputForm
+             (imagk(x) = 1) => part
+             (imagk(x) :: OutputForm) * part
+           zero? y => z
+           z + (y :: OutputForm)
+         -- we know that the real part,i,j,k parts are 0
+         not zero?(imagE(x)) =>
+           y := octon(0$R,0$R,0$R,0$R,0$R,
+             imagI(x),imagJ(x),imagK(x))
+           z :=
+             part := "E"::Symbol::OutputForm
+             (imagE(x) = 1) => part
+             (imagE(x) :: OutputForm) * part
+           zero? y => z
+           z + (y :: OutputForm)
+         -- we know that the real part,i,j,k,E parts are 0
+         not zero?(imagI(x)) =>
+           y := octon(0$R,0$R,0$R,0$R,0$R,0$R,imagJ(x),imagK(x))
+           z :=
+             part := "I"::Symbol::OutputForm
+             (imagI(x) = 1) => part
+             (imagI(x) :: OutputForm) * part
+           zero? y => z
+           z + (y :: OutputForm)
+         -- we know that the real part,i,j,k,E,I parts are 0
+         not zero?(imagJ(x)) =>
+           y := octon(0$R,0$R,0$R,0$R,0$R,0$R,0$R,imagK(x))
+           z :=
+             part := "J"::Symbol::OutputForm
+             (imagJ(x) = 1) => part
+             (imagJ(x) :: OutputForm) * part
+           zero? y => z
+           z + (y :: OutputForm)
+         -- we know that the real part,i,j,k,E,I,J parts are 0
+         part := "K"::Symbol::OutputForm
+         (imagK(x) = 1) => part
+         (imagK(x) :: OutputForm) * part
+ 
+     if R has Field then
+
+       inv : % -> %
+       inv x ==
+         (norm x) = 0 => error "This octonion is not invertible."
+         (inv norm x) * conjugate x
+
+     if R has ConvertibleTo InputForm then
+
+       convert : % -> InputForm
+       convert(x:%):InputForm ==
+         l : List InputForm := [convert("octon" :: Symbol),
+           convert(real x)$R, convert(imagi x)$R, convert(imagj x)$R,_
+             convert(imagk x)$R, convert(imagE x)$R,_
+             convert(imagI x)$R, convert(imagJ x)$R,_
+             convert(imagK x)$R]
+         convert(l)$InputForm
+
+     if R has OrderedSet then
+
+       ?<? : (%,%) -> Boolean
+       x < y ==
+         real x = real y =>
+          imagi x = imagi y =>
+           imagj x = imagj y =>
+            imagk x = imagk y =>
+             imagE x = imagE y =>
+              imagI x = imagI y =>
+               imagJ x = imagJ y =>
+                imagK x < imagK y
+               imagJ x < imagJ y
+              imagI x < imagI y
+             imagE x < imagE y
+            imagk x < imagk y 
+           imagj x < imagj y 
+          imagi x < imagi y 
+         real x < real y
+ 
+     if R has RealNumberSystem then
+
+       abs : % -> R
+       abs x == sqrt norm x
+ 
+     if R has IntegerNumberSystem then
+
+       rational? : % -> Boolean
+       rational? x ==
+         (zero? imagi x) and (zero? imagj x) and (zero? imagk x) and _ 
+         (zero? imagE x) and (zero? imagI x) and (zero? imagJ x) and _
+         (zero? imagK x)
+
+       rational : % -> Fraction(Integer)
+       rational  x ==
+         rational? x => rational real x
+         error "Not a rational number"
+
+       rationalIfCan : % -> Union(Fraction(Integer),"failed")
+       rationalIfCan x ==
+         rational? x => rational real x
+         "failed"
+*)
+
+\end{chunk}
+
 \begin{chunk}{OC.dotabb}
 "OC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OC"];
@@ -48991,6 +55664,7 @@ OctonionCategory(R: CommutativeRing): Category ==
 "OC" -> "FRETRCT"
 
 \end{chunk}
+
 \begin{chunk}{OC.dotfull}
 "OctonionCategory(a:CommutativeRing)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OC"];
@@ -49000,6 +55674,7 @@ OctonionCategory(R: CommutativeRing): Category ==
    "FullyRetractableTo(a:CommutativeRing)"
 
 \end{chunk}
+
 \begin{chunk}{OC.dotpic}
 digraph pic {
  fontsize=10;
@@ -49017,6 +55692,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{QuaternionCategory}{QUATCAT}
 \pagepic{ps/v102quaternioncategory.ps}{QUATCAT}{0.70}
@@ -49110,6 +55786,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{QuaternionCategory.help}
 ====================================================================
 QuaternionCategory examples
@@ -49432,7 +56109,6 @@ QuaternionCategory(R: CommutativeRing): Category ==
          quatern(n :: R,0$R,0$R,0$R)
 
        one? x ==
---         one? real x and zero? imagI x and
          (real x) = 1 and zero? imagI x and
            zero? imagJ x and zero? imagK x
 
@@ -49463,7 +56139,6 @@ QuaternionCategory(R: CommutativeRing): Category ==
            y := quatern(0$R,0$R,imagJ(x),imagK(x))
            z :=
              part := "i"::Symbol::OutputForm
---             one? imagI(x) => part
              (imagI(x) = 1) => part
              (imagI(x) :: OutputForm) * part
            zero? y => z
@@ -49473,14 +56148,12 @@ QuaternionCategory(R: CommutativeRing): Category ==
            y := quatern(0$R,0$R,0$R,imagK(x))
            z :=
              part := "j"::Symbol::OutputForm
---             one? imagJ(x) => part
              (imagJ(x) = 1) => part
              (imagJ(x) :: OutputForm) * part
            zero? y => z
            z + (y :: OutputForm)
          -- we know that the real part and i and j parts are 0
          part := "k"::Symbol::OutputForm
---         one? imagK(x) => part
          (imagK(x) = 1) => part
          (imagK(x) :: OutputForm) * part
  
@@ -49522,6 +56195,173 @@ QuaternionCategory(R: CommutativeRing): Category ==
            "failed"
 
 \end{chunk}
+
+\begin{chunk}{COQ QUATCAT}
+(* category QUATCAT *)
+(*
+ 
+       characteristic : () -> NonNegativeInteger
+       characteristic() ==
+         characteristic()$R
+
+       conjugate : % -> %
+       conjugate x ==
+         quatern(real x, - imagI x, - imagJ x, - imagK x)
+
+       map : ((R -> R),%) -> %
+       map(fn, x) ==
+         quatern(fn real x, fn imagI x, fn imagJ x, fn imagK x)
+
+       norm : % -> R
+       norm x ==
+         real x * real x + imagI x * imagI x +
+           imagJ x * imagJ x + imagK x * imagK x
+
+       ?=? : (%,%) -> Boolean
+       x = y ==
+         (real x = real y) and (imagI x = imagI y) and
+           (imagJ x = imagJ y) and (imagK x = imagK y)
+
+       ?+? : (%,%) -> %
+       x + y ==
+         quatern(real x + real y, imagI x + imagI y,
+           imagJ x + imagJ y, imagK x + imagK y)
+
+       ?-? : (%,%) -> %
+       x - y ==
+         quatern(real x - real y, imagI x - imagI y,
+           imagJ x - imagJ y, imagK x - imagK y)
+
+       -? : % -> %
+       - x ==
+         quatern(- real x, - imagI x, - imagJ x, - imagK x)
+
+       ?*? : (R,%) -> %
+       r:R * x:$ ==
+         quatern(r * real x, r * imagI x, r * imagJ x, r * imagK x)
+
+       ?*? : (Integer,%) -> %
+       n:Integer * x:$  ==
+         quatern(n * real x, n * imagI x, n * imagJ x, n * imagK x)
+
+       differentiate : (%,(R -> R)) -> %
+       differentiate(x:$, d:R -> R) ==
+         quatern(d real x, d imagI x, d imagJ x, d imagK x)
+
+       coerce : R -> %
+       coerce(r:R) ==
+         quatern(r,0$R,0$R,0$R)
+
+       coerce : Integer -> %
+       coerce(n:Integer) ==
+         quatern(n :: R,0$R,0$R,0$R)
+
+       one? : % -> Boolean
+       one? x ==
+         (real x) = 1 and zero? imagI x and
+           zero? imagJ x and zero? imagK x
+
+       zero? : % -> Boolean
+       zero? x ==
+         zero? real x and zero? imagI x and
+           zero? imagJ x and zero? imagK x
+
+       retract : % -> R
+       retract(x):R ==
+         not (zero? imagI x and zero? imagJ x and zero? imagK x) =>
+           error "Cannot retract quaternion."
+         real x
+
+       rationalIfCan : % -> Union(Fraction(Integer),"failed")
+       retractIfCan(x):Union(R,"failed") ==
+         not (zero? imagI x and zero? imagJ x and zero? imagK x) =>
+           "failed"
+         real x
+ 
+       coerce : % -> OutputForm
+       coerce(x:$):OutputForm ==
+         part,z : OutputForm
+         y : $
+         zero? x => (0$R) :: OutputForm
+         not zero?(real x) =>
+           y := quatern(0$R,imagI(x),imagJ(x),imagK(x))
+           zero? y => real(x) :: OutputForm
+           (real(x) :: OutputForm) + (y :: OutputForm)
+         -- we know that the real part is 0
+         not zero?(imagI(x)) =>
+           y := quatern(0$R,0$R,imagJ(x),imagK(x))
+           z :=
+             part := "i"::Symbol::OutputForm
+             (imagI(x) = 1) => part
+             (imagI(x) :: OutputForm) * part
+           zero? y => z
+           z + (y :: OutputForm)
+         -- we know that the real part and i part are 0
+         not zero?(imagJ(x)) =>
+           y := quatern(0$R,0$R,0$R,imagK(x))
+           z :=
+             part := "j"::Symbol::OutputForm
+             (imagJ(x) = 1) => part
+             (imagJ(x) :: OutputForm) * part
+           zero? y => z
+           z + (y :: OutputForm)
+         -- we know that the real part and i and j parts are 0
+         part := "k"::Symbol::OutputForm
+         (imagK(x) = 1) => part
+         (imagK(x) :: OutputForm) * part
+ 
+       if R has Field then
+
+         inv : % -> %
+         inv x ==
+           norm x = 0 => error "This quaternion is not invertible."
+           (inv norm x) * conjugate x
+ 
+       if R has ConvertibleTo InputForm then
+
+         convert : % -> InputForm
+         convert(x:$):InputForm ==
+           l : List InputForm := [convert("quatern" :: Symbol),
+             convert(real x)$R, convert(imagI x)$R, convert(imagJ x)$R,
+               convert(imagK x)$R]
+           convert(l)$InputForm
+ 
+       if R has OrderedSet then
+
+         ?<? : (%,%) -> Boolean
+         x < y ==
+           real x = real y =>
+             imagI x = imagI y =>
+               imagJ x = imagJ y =>
+                 imagK x < imagK y
+               imagJ x < imagJ y
+             imagI x < imagI y
+           real x < real y
+ 
+       if R has RealNumberSystem then
+
+         abs : % -> R
+         abs x == sqrt norm x
+ 
+       if R has IntegerNumberSystem then
+
+         rational? : % -> Boolean
+         rational? x ==
+           (zero? imagI x) and (zero? imagJ x) and (zero? imagK x)
+
+         rational : % -> Fraction(Integer)
+         rational  x ==
+           rational? x => rational real x
+           error "Not a rational number"
+
+         rationalIfCan : % -> Union(Fraction(Integer),"failed")
+         rationalIfCan x ==
+           rational? x => rational real x
+           "failed"
+*)
+
+\end{chunk}
+
 \begin{chunk}{QUATCAT.dotabb}
 "QUATCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=QUATCAT"];
@@ -49532,6 +56372,7 @@ QuaternionCategory(R: CommutativeRing): Category ==
 "QUATCAT" -> "FRETRCT"
 
 \end{chunk}
+
 \begin{chunk}{QUATCAT.dotfull}
 "QuaternionCategory(a:CommutativeRing)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=QUATCAT"];
@@ -49547,6 +56388,7 @@ QuaternionCategory(R: CommutativeRing): Category ==
    "FullyRetractableTo(a:CommutativeRing)"
 
 \end{chunk}
+
 \begin{chunk}{QUATCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -49568,6 +56410,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{SquareMatrixCategory}{SMATCAT}
 \pagepic{ps/v102squarematrixcategory.ps}{SMATCAT}{0.25}
@@ -49687,6 +56530,7 @@ The SquareMatrix domain is for square matrices of fixed dimension.
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{SquareMatrixCategory.help}
 ====================================================================
 SquareMatrixCategory examples
@@ -50020,7 +56864,6 @@ SquareMatrixCategory(ndim,R,Row,Col): Category == Definition where
 
     positivePower:(%,Integer) -> %
     positivePower(x,n) ==
---      one? n => x
       (n = 1) => x
       odd? n => x * positivePower(x,n - 1)
       y := positivePower(x,n quo 2)
@@ -50094,6 +56937,105 @@ SquareMatrixCategory(ndim,R,Row,Col): Category == Definition where
         positivePower(xInv :: %,-n)
 
 \end{chunk}
+
+\begin{chunk}{COQ SMATCAT}
+(* category SMATCAT *)
+(*
+    minr ==> minRowIndex
+    maxr ==> maxRowIndex
+    minc ==> minColIndex
+    maxc ==> maxColIndex
+    mini ==> minIndex
+    maxi ==> maxIndex
+
+    positivePower:(%,Integer) -> %
+    positivePower(x,n) ==
+      (n = 1) => x
+      odd? n => x * positivePower(x,n - 1)
+      y := positivePower(x,n quo 2)
+      y * y
+
+    ?**? : (%,NonNegativeInteger) -> %
+    x:% ** n:NonNegativeInteger ==
+      zero? n => scalarMatrix 1
+      positivePower(x,n)
+
+    coerce : R -> %
+    coerce(r:R) == scalarMatrix r
+
+    differentiate : (%,(R -> R)) -> %
+    differentiate(x:%,d:R -> R) == map(d,x)
+
+    diagonal : % -> Row
+    diagonal x ==
+      v:Vector(R) := new(ndim,0)
+      for i in minr x .. maxr x
+        for j in minc x .. maxc x
+          for k in minIndex v .. maxIndex v repeat
+            qsetelt_!(v, k, qelt(x, i, j))
+      directProduct v
+
+    retract : % -> R
+    retract(x:%):R ==
+      diagonal? x => retract diagonal x
+      error "Not retractable"
+
+    retractIfCan : % -> Union(R,"failed")
+    retractIfCan(x:%):Union(R, "failed") ==
+      diagonal? x => retractIfCan diagonal x
+      "failed"
+
+    equation2R: Vector % -> Matrix R
+    equation2R v ==
+      ans:Matrix(Col) := new(ndim,#v,0)
+      for i in minr ans .. maxr ans repeat
+        for j in minc ans .. maxc ans repeat
+          qsetelt_!(ans, i, j, column(qelt(v, j), i))
+      reducedSystem ans
+
+    reducedSystem : Matrix(%) -> Matrix(Integer)
+    reducedSystem(x:Matrix %):Matrix(R) ==
+      empty? x => new(0,0,0)
+      reduce(vertConcat, [equation2R row(x, i)
+                               for i in minr x .. maxr x])$List(Matrix R)
+
+    reducedSystem : (Matrix(%),Vector(%)) ->
+     Record(mat: Matrix(R),vec: Vector(R))
+    reducedSystem(m:Matrix %, v:Vector %):
+     Record(mat:Matrix R, vec:Vector R) ==
+      vh:Vector(R) :=
+        empty? v => new(0,0)
+        rh := reducedSystem(v::Matrix %)@Matrix(R)
+        column(rh, minColIndex rh)
+      [reducedSystem(m)@Matrix(R), vh]
+
+    trace : % -> R
+    trace x ==
+      tr : R := 0
+      for i in minr(x)..maxr(x) for j in minc(x)..maxc(x) repeat
+        tr := tr + x(i,j)
+      tr
+
+    diagonalProduct : % -> R
+    diagonalProduct x ==
+      pr : R := 1
+      for i in minr(x)..maxr(x) for j in minc(x)..maxc(x) repeat
+        pr := pr * x(i,j)
+      pr
+
+    if R has Field then
+
+      ?**? : (%,Integer) -> %
+      x:% ** n:Integer ==
+        zero? n => scalarMatrix 1
+        positive? n => positivePower(x,n)
+        (xInv := inverse x) case "failed" =>
+          error "**: matrix must be invertible"
+        positivePower(xInv :: %,-n)
+*)
+
+\end{chunk}
+
 \begin{chunk}{SMATCAT.dotabb}
 "SMATCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=SMATCAT"];
@@ -50119,6 +57061,7 @@ SquareMatrixCategory(ndim,R,Row,Col): Category == Definition where
  -> "RectangularMatrixCategory(a:NonNegativeInteger,b:NonNegativeInteger,c:Ring,d:DirectProductCategory(b,c),e:DirectProductCategory(a,c))"
 
 \end{chunk}
+
 \begin{chunk}{SMATCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -50202,6 +57145,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{XPolynomialsCat}{XPOLYC}
 \pagepic{ps/v102xpolynomialscat.ps}{XPOLYC}{0.50}
@@ -50263,6 +57207,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{XPolynomialsCat.help}
 ====================================================================
 XPolynomialsCat examples
@@ -50438,12 +57383,14 @@ XPolynomialsCat(vl:OrderedSet,R:Ring):Category == Export where
       ++ at order \spad{n}.
 
 \end{chunk}
+
 \begin{chunk}{XPOLYC.dotabb}
 "XPOLYC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=XPOLYC"];
 "XPOLYC" -> "XFALG"
 
 \end{chunk}
+
 \begin{chunk}{XPOLYC.dotfull}
 "XPolynomialsCat(a:OrderedRing,b:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=XPOLYC"];
@@ -50451,6 +57398,7 @@ XPolynomialsCat(vl:OrderedSet,R:Ring):Category == Export where
    "XFreeAlgebra(a:OrderedSet,b:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{XPOLYC.dotpic}
 digraph pic {
  fontsize=10;
@@ -50521,6 +57469,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 12}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{AbelianMonoidRing}{AMR}
@@ -50578,6 +57527,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{AbelianMonoidRing.help}
 ====================================================================
 AbelianMonoidRing examples
@@ -50801,6 +57751,31 @@ AbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category ==
     q:Fraction(Integer) * p:% == map(x1 +-> q * x1, p)
 
 \end{chunk}
+
+\begin{chunk}{COQ AMR}
+(* category AMR *)
+(*
+
+  monomial? : % -> Boolean
+  monomial? x == zero? reductum x
+
+  map : ((R -> R),%) -> %
+  map(fn:R -> R, x: %) ==
+        -- this default definition assumes that reductum is cheap
+     zero? x => 0
+     r:=fn leadingCoefficient x
+     zero? r => map(fn,reductum x)
+     monomial(r, degree x) + map(fn,reductum x)
+
+  if R has Algebra Fraction Integer then
+
+    ?*? : (Integer,%) -> %
+    q:Fraction(Integer) * p:% == map(x1 +-> q * x1, p)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{AMR.dotabb}
 "AMR"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=AMR"];
@@ -50812,6 +57787,7 @@ AbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category ==
 "AMR" -> "ALGEBRA"
 
 \end{chunk}
+
 \begin{chunk}{AMR.dotfull}
 "AbelianMonoidRing(a:Ring,b:OrderedAbelianMonoid)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=AMR"];
@@ -50828,6 +57804,7 @@ AbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category ==
     "Algebra(Fraction(Integer))"
 
 \end{chunk}
+
 \begin{chunk}{AMR.dotpic}
 digraph pic {
  fontsize=10;
@@ -50879,6 +57856,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FortranMachineTypeCategory}{FMTC}
 \pagepic{ps/v102fortranmachinetypecategory.ps}{FMTC}{0.40}
@@ -50929,6 +57907,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FortranMachineTypeCategory.help}
 ====================================================================
 FortranMachineTypeCategory examples
@@ -51073,6 +58052,7 @@ FortranMachineTypeCategory():Category == Join(IntegralDomain,OrderedSet,
 "FMTC" -> "RETRACT"
 
 \end{chunk}
+
 \begin{chunk}{FMTC.dotfull}
 "FortranMachineTypeCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FMTC"];
@@ -51081,6 +58061,7 @@ FortranMachineTypeCategory():Category == Join(IntegralDomain,OrderedSet,
 "FortranMachineTypeCategory()" -> "RetractableTo(Integer)"
 
 \end{chunk}
+
 \begin{chunk}{FMTC.dotpic}
 digraph pic {
  fontsize=10;
@@ -51149,6 +58130,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FramedNonAssociativeAlgebra}{FRNAALG}
 \pagepic{ps/v102framednonassociativealgebra.ps}{FRNAALG}{0.75}
@@ -51237,6 +58219,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FramedNonAssociativeAlgebra.help}
 ====================================================================
 FramedNonAssociativeAlgebra examples
@@ -51768,12 +58751,257 @@ FramedNonAssociativeAlgebra(R:CommutativeRing):
       m
 
 \end{chunk}
+
+\begin{chunk}{COQ FRNAALG}
+(* category FRNAALG *)
+(*
+
+    V  ==> Vector
+    M  ==> Matrix
+    P  ==> Polynomial
+    F  ==> Fraction
+    REC  ==> Record(particular: Union(V R,"failed"),basis: List V R)
+    LSMP ==> LinearSystemMatrixPackage(R,V R,V R, M R)
+    CVMP ==> CoerceVectorMatrixPackage(R)
+
+    --GA ==> GenericNonAssociativeAlgebra(R,rank()$%,_
+    -- [random()$Character :: String :: Symbol for i in 1..rank()$%], _
+    -- structuralConstants()$%)
+    --y : GA := generic()
+    if R has Field then
+
+      leftRankPolynomial : () -> SparseUnivariatePolynomial(Polynomial(R))
+      leftRankPolynomial() ==
+        n := rank()
+        b := basis()
+        gamma : Vector Matrix R := structuralConstants b
+        listOfNumbers : List String:= [PRINC_-TO_-STRING(q)$Lisp for q in 1..n]
+        symbolsForCoef : Vector Symbol :=
+          [concat("%", concat("x", i))::Symbol  for i in listOfNumbers]
+        xx : M P R
+        mo : P R
+        x : M P R := new(1,n,0)
+        for i in 1..n repeat
+          mo := monomial(1, [symbolsForCoef.i], [1])$(P R)
+          qsetelt_!(x,1,i,mo)
+        y : M P R := copy x
+        k  : PositiveInteger := 1
+        cond : M P R := copy x
+        -- multiplication in the generic algebra means using
+        -- the structural matrices as bilinear forms.
+        -- left multiplication by x, we prepare for that:
+        genGamma : V M P R :=  coerceP$CVMP gamma
+        x := reduce(horizConcat,[x*genGamma(i) for i in 1..#genGamma])
+        while rank(cond) = k repeat
+          k := k+1
+          for i in 1..n repeat
+            setelt(xx,[1],[i],x*transpose y)
+          y := copy xx
+          cond := horizConcat(cond, xx)
+        vectorOfCoef : Vector P R := (nullSpace(cond)$Matrix(P R)).first
+        res : SparseUnivariatePolynomial P R := 0
+        for i in 1..k repeat
+         res:=res+monomial(vectorOfCoef.i,i)$(SparseUnivariatePolynomial P R)
+        res
+
+      rightRankPolynomial : () -> SparseUnivariatePolynomial(Polynomial(R))
+      rightRankPolynomial() ==
+        n := rank()
+        b := basis()
+        gamma : Vector Matrix R := structuralConstants b
+        listOfNumbers : List String :=[PRINC_-TO_-STRING(q)$Lisp for q in 1..n]
+        symbolsForCoef : Vector Symbol :=
+          [concat("%", concat("x", i))::Symbol  for i in listOfNumbers]
+        xx : M P R
+        mo : P R
+        x : M P R := new(1,n,0)
+        for i in 1..n repeat
+          mo := monomial(1, [symbolsForCoef.i], [1])$(P R)
+          qsetelt_!(x,1,i,mo)
+        y : M P R := copy x
+        k  : PositiveInteger := 1
+        cond : M P R := copy x
+        -- multiplication in the generic algebra means using
+        -- the structural matrices as bilinear forms.
+        -- left multiplication by x, we prepare for that:
+        genGamma : V M P R :=  coerceP$CVMP gamma
+        x := _
+         reduce(horizConcat,[genGamma(i)*transpose x for i in 1..#genGamma])
+        while rank(cond) = k repeat
+          k := k+1
+          for i in 1..n repeat
+            setelt(xx,[1],[i],y * transpose x)
+          y := copy xx
+          cond := horizConcat(cond, xx)
+        vectorOfCoef : Vector P R := (nullSpace(cond)$Matrix(P R)).first
+        res : SparseUnivariatePolynomial P R := 0
+        for i in 1..k repeat
+         res := _
+          res+monomial(vectorOfCoef.i,i)$(SparseUnivariatePolynomial  P R)
+        res
+
+      leftUnitsInternal : () -> REC
+      leftUnitsInternal() ==
+        n := rank()
+        b := basis()
+        gamma : Vector Matrix R := structuralConstants b
+        cond : Matrix(R) := new(n**2,n,0$R)$Matrix(R)
+        rhs : Vector(R) := new(n**2,0$R)$Vector(R)
+        z : Integer := 0
+        addOn : R := 0
+        for k in 1..n repeat
+         for i in 1..n repeat
+           z := z+1   -- index for the rows
+           addOn :=
+             k=i => 1
+             0
+           setelt(rhs,z,addOn)$Vector(R)
+           for j in 1..n repeat  -- index for the columns
+             setelt(cond,z,j,elt(gamma.k,j,i))$Matrix(R)
+        solve(cond,rhs)$LSMP
+
+
+      leftUnit : () -> Union(%,"failed")
+      leftUnit() ==
+        res : REC := leftUnitsInternal()
+        res.particular case "failed" =>
+          messagePrint("this algebra has no left unit")$OutputForm
+          "failed"
+        represents (res.particular :: V R)
+
+      leftUnits : () -> Union(Record(particular: %,basis: List(%)),"failed")
+      leftUnits() ==
+        res : REC := leftUnitsInternal()
+        res.particular case "failed" =>
+          messagePrint("this algebra has no left unit")$OutputForm
+          "failed"
+        [represents(res.particular :: V R)$%, _
+          map(represents, res.basis)$ListFunctions2(Vector R, %) ]
+
+      rightUnitsInternal : () -> REC
+      rightUnitsInternal() ==
+        n := rank()
+        b := basis()
+        gamma : Vector Matrix R := structuralConstants b
+        condo : Matrix(R) := new(n**2,n,0$R)$Matrix(R)
+        rhs : Vector(R) := new(n**2,0$R)$Vector(R)
+        z : Integer := 0
+        addOn : R := 0
+        for k in 1..n repeat
+         for i in 1..n repeat
+           z := z+1   -- index for the rows
+           addOn :=
+             k=i => 1
+             0
+           setelt(rhs,z,addOn)$Vector(R)
+           for j in 1..n repeat  -- index for the columns
+             setelt(condo,z,j,elt(gamma.k,i,j))$Matrix(R)
+        solve(condo,rhs)$LSMP
+
+      rightUnit : () -> Union(%,"failed")
+      rightUnit() ==
+        res : REC := rightUnitsInternal()
+        res.particular case "failed" =>
+          messagePrint("this algebra has no right unit")$OutputForm
+          "failed"
+        represents (res.particular :: V R)
+
+      rightUnits : () -> Union(Record(particular: %,basis: List(%)),"failed")
+      rightUnits() ==
+        res : REC := rightUnitsInternal()
+        res.particular case "failed" =>
+          messagePrint("this algebra has no right unit")$OutputForm
+          "failed"
+        [represents(res.particular :: V R)$%, _
+          map(represents, res.basis)$ListFunctions2(Vector R, %) ]
+
+      unit : () -> Union(%,"failed")
+      unit() ==
+        n := rank()
+        b := basis()
+        gamma : Vector Matrix R := structuralConstants b
+        cond : Matrix(R) := new(2*n**2,n,0$R)$Matrix(R)
+        rhs : Vector(R) := new(2*n**2,0$R)$Vector(R)
+        z : Integer := 0
+        u : Integer := n*n
+        addOn : R := 0
+        for k in 1..n repeat
+         for i in 1..n repeat
+           z := z+1   -- index for the rows
+           addOn :=
+             k=i => 1
+             0
+           setelt(rhs,z,addOn)$Vector(R)
+           setelt(rhs,u,addOn)$Vector(R)
+           for j in 1..n repeat  -- index for the columns
+             setelt(cond,z,j,elt(gamma.k,j,i))$Matrix(R)
+             setelt(cond,u,j,elt(gamma.k,i,j))$Matrix(R)
+        res : REC := solve(cond,rhs)$LSMP
+        res.particular case "failed" =>
+          messagePrint("this algebra has no unit")$OutputForm
+          "failed"
+        represents (res.particular :: V R)
+
+    apply : (Matrix(R),%) -> %
+    apply(m:Matrix(R),a:%) ==
+      v : Vector R := coordinates(a)
+      v := m *$Matrix(R) v
+      convert v
+
+    structuralConstants : () -> Vector(Matrix(R))
+    structuralConstants() == structuralConstants basis()
+
+    conditionsForIdempotents : () -> List(Polynomial(R))
+    conditionsForIdempotents() == conditionsForIdempotents basis()
+
+    convert : % -> Vector(R)
+    convert(x:%):Vector(R) == coordinates(x, basis())
+
+    convert : Vector(R) -> %
+    convert(v:Vector R):% == represents(v, basis())
+
+    leftTraceMatrix : () -> Matrix(R)
+    leftTraceMatrix() == leftTraceMatrix basis()
+
+    rightTraceMatrix : () -> Matrix(R)
+    rightTraceMatrix() == rightTraceMatrix basis()
+
+    leftDiscriminant : () -> R
+    leftDiscriminant() == leftDiscriminant basis()
+
+    rightDiscriminant : Vector(%) -> R
+    rightDiscriminant() == rightDiscriminant basis()
+
+    leftRegularRepresentation : % -> Matrix(R)
+    leftRegularRepresentation x == leftRegularRepresentation(x, basis())
+
+    rightRegularRepresentation : % -> Matrix(R)
+    rightRegularRepresentation x == rightRegularRepresentation(x, basis())
+
+    coordinates : % -> Vector(R)
+    coordinates x == coordinates(x, basis())
+
+    represents : Vector(R) -> %
+    represents(v:Vector R):%== represents(v, basis())
+
+    coordinates : Vector(%) -> Matrix(R)
+    coordinates(v:Vector %) ==
+      m := new(#v, rank(), 0)$Matrix(R)
+      for i in minIndex v .. maxIndex v for j in minRowIndex m .. repeat
+        setRow_!(m, j, coordinates qelt(v, i))
+      m
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FRNAALG.dotabb}
 "FRNAALG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FRNAALG"];
 "FRNAALG" -> "FINAALG"
 
 \end{chunk}
+
 \begin{chunk}{FRNAALG.dotfull}
 "FramedNonAssociativeAlgebra(a:CommutativeRing)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FRNAALG"];
@@ -51781,6 +59009,7 @@ FramedNonAssociativeAlgebra(R:CommutativeRing):
     "FiniteRankNonAssociativeAlgebra(a:CommutativeRing)"
 
 \end{chunk}
+
 \begin{chunk}{FRNAALG.dotpic}
 digraph pic {
  fontsize=10;
@@ -51885,6 +59114,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{GcdDomain.help}
 ====================================================================
 GcdDomain examples
@@ -52077,18 +59307,75 @@ GcdDomain(): Category == Join(IntegralDomain, LeftOreRing) with
      [cc1*c1, cc1, cc2]
    
 \end{chunk}
+
+\begin{chunk}{COQ GCDDOM}
+(* category GCDDOM *)
+(*
+
+   lcm : (%,%) -> %
+   lcm(x: %,y: %) ==
+     y = 0 => 0
+     x = 0 => 0
+     LCM : Union(%,"failed") := y exquo gcd(x,y)
+     LCM case % =>  x * LCM
+     error "bad gcd in lcm computation"
+
+   lcm : List(%) -> %
+   lcm(l:List %) == reduce(lcm,l,1,0)
+
+   gcd : List(%) -> %
+   gcd(l:List %) == reduce(gcd,l,0,1)
+
+   SUP ==> SparseUnivariatePolynomial
+
+   gcdPolynomial : (SparseUnivariatePolynomial(%),
+                    SparseUnivariatePolynomial(%)) ->
+          SparseUnivariatePolynomial(%)
+   gcdPolynomial(p1,p2) ==
+     zero? p1 => unitCanonical p2
+     zero? p2 => unitCanonical p1
+     c1:= content(p1); c2:= content(p2)
+     p1:= (p1 exquo c1)::SUP %
+     p2:= (p2 exquo c2)::SUP %
+     if (e1:=minimumDegree p1) > 0 then p1:=(p1 exquo monomial(1,e1))::SUP %
+     if (e2:=minimumDegree p2) > 0 then p2:=(p2 exquo monomial(1,e2))::SUP %
+     e1:=min(e1,e2); c1:=gcd(c1,c2)
+     p1:=
+        degree p1 = 0 or degree p2 = 0 => monomial(c1,0)
+        p:= subResultantGcd(p1,p2)
+        degree p = 0 => monomial(c1,0)
+        c2:= gcd(leadingCoefficient p1,leadingCoefficient p2)
+        unitCanonical(_
+          c1 * primitivePart(((c2*p) exquo leadingCoefficient p)::SUP %))
+     zero? e1 => p1
+     monomial(1,e1)*p1
+
+   -- See [Delenclos 06], [Bronstein 96a]
+   lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
+   lcmCoef(c1, c2) ==
+     g := gcd(c1, c2)
+     cc1 := (c2 exquo g)::%
+     cc2 := (c1 exquo g)::%
+     [cc1*c1, cc1, cc2]
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{GCDDOM.dotabb}
 "GCDDOM"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=GCDDOM"];
 "GCDDOM" -> "INTDOM"
 
 \end{chunk}
+
 \begin{chunk}{GCDDOM.dotfull}
 "GcdDomain()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=GCDDOM"];
 "GcdDomain()" -> "IntegralDomain()"
 
 \end{chunk}
+
 \begin{chunk}{GCDDOM.dotpic}
 digraph pic {
  fontsize=10;
@@ -52127,6 +59414,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{OrderedIntegralDomain}{OINTDOM}
 \pagepic{ps/v102orderedintegraldomain.ps}{OINTDOM}{0.45}
@@ -52177,6 +59465,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{OrderedIntegralDomain.help}
 ====================================================================
 OrderedIntegralDomain examples
@@ -52313,6 +59602,7 @@ OrderedIntegralDomain(): Category ==
   Join(IntegralDomain, OrderedRing) 
 
 \end{chunk}
+
 \begin{chunk}{OINTDOM.dotabb}
 "OINTDOM"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OINTDOM"];
@@ -52320,6 +59610,7 @@ OrderedIntegralDomain(): Category ==
 "OINTDOM" -> "ORDRING"
 
 \end{chunk}
+
 \begin{chunk}{OINTDOM.dotfull}
 "OrderedIntegralDomain()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=OINTDOM"];
@@ -52327,6 +59618,7 @@ OrderedIntegralDomain(): Category ==
 "OrderedIntegralDomain()" -> "OrderedRing()"
 
 \end{chunk}
+
 \begin{chunk}{OINTDOM.dotpic}
 digraph pic {
  fontsize=10;
@@ -52374,6 +59666,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 13}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FiniteAbelianMonoidRing}{FAMR}
@@ -52444,6 +59737,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FiniteAbelianMonoidRing.help}
 ====================================================================
 FiniteAbelianMonoidRing examples
@@ -52722,7 +60016,6 @@ FiniteAbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category ==
           zero? x => 0
           r:=leadingCoefficient x
           x:=reductum x
---          while not zero? x and not one? r repeat
           while not zero? x and not (r = 1) repeat
             r:=gcd(r,leadingCoefficient x)
             x:=reductum x
@@ -52734,6 +60027,91 @@ FiniteAbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category ==
           unitCanonical((x exquo c)::%)
 
 \end{chunk}
+
+\begin{chunk}{COQ FAMR}
+(* category FAMR *)
+(*
+
+    pomopo! : (%,R,E,%) -> %
+    pomopo!(p1,r,e,p2) == p1 + r * mapExponents(x1+->x1+e,p2)
+
+    if R has CommutativeRing then 
+
+       binomThmExpt : (%,%,NonNegativeInteger) -> %
+       binomThmExpt(x,y,nn) ==
+               nn = 0 => 1$%
+               ans,xn,yn: %
+               bincoef: Integer
+               powl: List(%):= [x]
+               for i in 2..nn repeat powl:=[x * powl.first, :powl]
+               yn:=y; ans:=powl.first; i:=1; bincoef:=nn
+               for xn in powl.rest repeat
+                  ans:= bincoef * xn * yn + ans
+                  bincoef:= (nn-i) * bincoef quo (i+1);  i:= i+1
+                  -- last I and BINCOEF unused
+                  yn:= y * yn
+               ans + yn
+
+    ground? : % -> Boolean
+    ground? x ==
+      retractIfCan(x)@Union(R,"failed") case "failed" => false
+      true
+
+    ground : % -> R
+    ground x == retract(x)@R
+
+    mapExponents : ((E -> E),%) -> %
+    mapExponents (fn:E -> E, x: %) ==
+         -- this default definition assumes that reductum is cheap
+       zero? x => 0
+       monomial(leadingCoefficient x,fn degree x)+mapExponents(fn,reductum x)
+
+    coefficients : % -> List(R)
+    coefficients x ==
+      zero? x => empty()
+      concat(leadingCoefficient x, coefficients reductum x)
+
+    if R has Field then
+
+       ?/? : (%,R) -> %
+       x/r == map(x1+->x1/r,x)
+
+    if R has IntegralDomain then
+
+       exquo : (%,R) -> Union(%,"failed")
+       x exquo r ==
+          -- probably not a very good definition in most special cases
+          zero? x => 0
+          ans:% :=0
+          t:=leadingCoefficient x exquo r
+          while not (t case "failed") and not zero? x repeat
+            ans:=ans+monomial(t::R,degree x)
+            x:=reductum x
+            if not zero? x then t:=leadingCoefficient x exquo r
+          t case "failed" => "failed"
+          ans
+
+    if R has GcdDomain then
+
+       content : % -> R
+       content x ==       -- this assumes  reductum is cheap
+          zero? x => 0
+          r:=leadingCoefficient x
+          x:=reductum x
+          while not zero? x and not (r = 1) repeat
+            r:=gcd(r,leadingCoefficient x)
+            x:=reductum x
+          r
+
+       primitivePart : % -> %
+       primitivePart x ==
+          zero? x => x
+          c := content x
+          unitCanonical((x exquo c)::%)
+*)
+
+\end{chunk}
+
 \begin{chunk}{FAMR.dotabb}
 "FAMR"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FAMR"];
@@ -52741,6 +60119,7 @@ FiniteAbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category ==
 "FAMR" -> "FRETRCT"
 
 \end{chunk}
+
 \begin{chunk}{FAMR.dotfull}
 "FiniteAbelianMonoidRing(a:Ring,b:OrderedAbelianMonoid)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FAMR"];
@@ -52755,6 +60134,7 @@ FiniteAbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category ==
     "FiniteAbelianMonoidRing(a:Ring,b:OrderedAbelianMonoid)"
 
 \end{chunk}
+
 \begin{chunk}{FAMR.dotpic}
 digraph pic {
  fontsize=10;
@@ -52821,6 +60201,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{IntervalCategory}{INTCAT}
 \pagepic{ps/v102intervalcategory.ps}{INTCAT}{0.60}
@@ -52895,6 +60276,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{IntervalCategory.help}
 ====================================================================
 IntervalCategory examples
@@ -53167,6 +60549,7 @@ IntervalCategory(R: Join(FloatingPointSystem,TranscendentalFunctionCategory)):
     ++ interval \axiom{i}, false otherwise.
 
 \end{chunk}
+
 \begin{chunk}{INTCAT.dotabb}
 "INTCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=INTCAT"];
@@ -53177,6 +60560,7 @@ IntervalCategory(R: Join(FloatingPointSystem,TranscendentalFunctionCategory)):
 "INTCAT" -> "TRANFUN"
 
 \end{chunk}
+
 \begin{chunk}{INTCAT.dotfull}
 "IntervalCategory(a:Join(FloatingPointSystem,TranscendentalFunctionCategory))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=INTCAT"];
@@ -53192,6 +60576,7 @@ IntervalCategory(R: Join(FloatingPointSystem,TranscendentalFunctionCategory)):
   -> "RetractableTo(Integer)"
 
 \end{chunk}
+
 \begin{chunk}{INTCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -53247,6 +60632,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PowerSeriesCategory}{PSCAT}
 \pagepic{ps/v102powerseriescategory.ps}{PSCAT}{0.60}
@@ -53307,6 +60693,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PowerSeriesCategory.help}
 ====================================================================
 PowerSeriesCategory examples
@@ -53509,12 +60896,47 @@ PowerSeriesCategory(Coef,Expon,Var): Category == Definition where
       ps:% / r:Coef == map((r1:Coef):Coef +-> r1 / r,ps)
 
 \end{chunk}
+
+\begin{chunk}{COQ PSCAT}
+(* category PSCAT *)
+(*
+
+    ?*? : (Integer,%) -> %
+    n:I * ps:% == (zero? n => 0; map((r1:Coef):Coef +-> n * r1,ps))
+
+    ?*? : (Coef,%) -> %
+    r:Coef * ps:% == (zero? r => 0; map((r1:Coef):Coef +-> r * r1,ps))
+
+    ?*? : (%,Coef) -> %
+    ps:% * r:Coef == (zero? r => 0; map((r1:Coef):Coef +-> r1 * r,ps))
+
+    -? : % -> %
+    - ps == map((r1:Coef):Coef +-> -r1,ps)
+
+    if Coef has Algebra Fraction Integer then
+
+      ?*? : (Fraction(Integer),%) -> %
+      r:RN * ps:% == (zero? r => 0; map((r1:Coef):Coef +-> r * r1,ps))
+
+      ?*? : (%,Fraction(Integer)) -> %
+      ps:% * r:RN == (zero? r => 0; map((r1:Coef):Coef +-> r1 * r,ps))
+
+    if Coef has Field then
+
+      ?/? : (%,Coef) -> %
+      ps:% / r:Coef == map((r1:Coef):Coef +-> r1 / r,ps)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{PSCAT.dotabb}
 "PSCAT" 
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PSCAT"];
 "PSCAT" -> "AMR"
 
 \end{chunk}
+
 \begin{chunk}{PSCAT.dotfull}
 "PowerSeriesCategory(a:Ring,b:OrderedAbelianMonoid,c:OrderedSet)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PSCAT"];
@@ -53532,6 +60954,7 @@ PowerSeriesCategory(Coef,Expon,Var): Category == Definition where
   -> "PowerSeriesCategory(a:Ring,b:OrderedAbelianMonoid,c:OrderedSet)"
 
 \end{chunk}
+
 \begin{chunk}{PSCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -53588,6 +61011,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PrincipalIdealDomain}{PID}
 \pagepic{ps/v102principalidealdomain.ps}{PID}{0.65}
@@ -53639,6 +61063,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PrincipalIdealDomain.help}
 ====================================================================
 PrincipalIdealDomain examples
@@ -53785,18 +61210,21 @@ PrincipalIdealDomain(): Category == GcdDomain with
          ++ is not in the ideal generated by the fi.
 
 \end{chunk}
+
 \begin{chunk}{PID.dotabb}
 "PID"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PID"];
 "PID" -> "GCDDOM"
 
 \end{chunk}
+
 \begin{chunk}{PID.dotfull}
 "PrincipalIdealDomain()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PID"];
 "PrincipalIdealDomain()" -> "GcdDomain()"
 
 \end{chunk}
+
 \begin{chunk}{PID.dotpic}
 digraph pic {
  fontsize=10;
@@ -53838,6 +61266,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{UniqueFactorizationDomain}{UFD}
 \pagepic{ps/v102uniquefactorizationdomain.ps}{UFD}{0.65}
@@ -53889,6 +61318,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{UniqueFactorizationDomain.help}
 ====================================================================
 UniqueFactorizationDomain examples
@@ -54049,18 +61479,36 @@ UniqueFactorizationDomain(): Category == GcdDomain with
   prime? x == # factorList factor x = 1
 
 \end{chunk}
+
+\begin{chunk}{COQ UFD}
+(* category UFD *)
+(*
+
+  squareFreePart : % -> %
+  squareFreePart x ==
+    unit(s := squareFree x) * _*/[f.factor for f in factors s]
+
+  prime? : % -> Boolean
+  prime? x == # factorList factor x = 1
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{UFD.dotabb}
 "UFD"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=UFD"];
 "UFD" -> "GCDDOM"
 
 \end{chunk}
+
 \begin{chunk}{UFD.dotfull}
 "UniqueFactorizationDomain()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=UFD"];
 "UniqueFactorizationDomain()" -> "GcdDomain()"
 
 \end{chunk}
+
 \begin{chunk}{UFD.dotpic}
 digraph pic {
  fontsize=10;
@@ -54102,6 +61550,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 14}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{DivisorCategory}{DIVCAT}
@@ -54154,6 +61603,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{DivisorCategory.help}
 ====================================================================
 DivisorCategory examples
@@ -54324,6 +61774,7 @@ DivisorCategory(S:SetCategory):Category == Exports where
     incr: % -> %
 
 \end{chunk}
+
 \begin{chunk}{DIVCAT.dotabb}
 "DIVCAT" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIVCAT"];
 "OAGROUP" [color=lightblue,href="bookvol10.2.pdf#nameddest=OAGROUP"];
@@ -54332,11 +61783,13 @@ DivisorCategory(S:SetCategory):Category == Exports where
 "DIVCAT" -> "PID"
 
 \end{chunk}
+
 \begin{chunk}{DIVCAT.dotfull}
 "DivisorCategory()" [color=lightblue,href="bookvol10.2.pdf#nameddest=DIVCAT"];
 "DivisorCategory()" -> "PrincipalIdealDomain()"
 
 \end{chunk}
+
 \begin{chunk}{DIVCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -54361,6 +61814,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{EuclideanDomain}{EUCDOM}
 \pagepic{ps/v102euclideandomain.ps}{EUCDOM}{0.65}
@@ -54418,6 +61872,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{EuclideanDomain.help}
 ====================================================================
 EuclideanDomain examples
@@ -54718,18 +62173,139 @@ EuclideanDomain(): Category == PrincipalIdealDomain with
          concat(v1,v2)
 
 \end{chunk}
+
+\begin{chunk}{COQ EUCDOM}
+(* category EUCDOM *)
+(*
+      x,y,z: %
+      l: List %
+
+      sizeLess? : (%,%) -> Boolean
+      sizeLess?(x,y) ==
+            zero? y => false
+            zero? x => true
+            euclideanSize(x)<euclideanSize(y)
+
+      ?quo? : (%,%) -> %
+      x quo y == divide(x,y).quotient --divide must be user-supplied
+
+      ?rem? : (%,%) -> %
+      x rem y == divide(x,y).remainder
+
+      exquo : (%,%) -> Union(%,"failed")
+      x exquo y ==
+         zero? x => 0
+         zero? y => "failed"
+         qr:=divide(x,y)
+         zero?(qr.remainder) => qr.quotient
+         "failed"
+
+      gcd : (%,%) -> %
+      gcd(x,y) ==                --Euclidean Algorithm
+         x:=unitCanonical x
+         y:=unitCanonical y
+         while not zero? y repeat
+            (x,y):= (y,x rem y)
+            y:=unitCanonical y   -- this doesn't affect the
+                                 -- correctness of Euclid's algorithm,
+                                 -- but
+                                 -- a) may improve performance
+                                 -- b) ensures gcd(x,y)=gcd(y,x)
+                                 --    if canonicalUnitNormal
+         x
+
+      IdealElt ==> Record(coef1:%,coef2:%,generator:%)
+
+      unitNormalizeIdealElt: IdealElt -> IdealElt
+      unitNormalizeIdealElt(s:IdealElt):IdealElt ==
+         (u,c,a):=unitNormal(s.generator)
+         (a = 1) => s
+         [a*s.coef1,a*s.coef2,c]$IdealElt
+
+      extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
+      extendedEuclidean(x,y) ==         --Extended Euclidean Algorithm
+         s1:=unitNormalizeIdealElt([1$%,0$%,x]$IdealElt)
+         s2:=unitNormalizeIdealElt([0$%,1$%,y]$IdealElt)
+         zero? y => s1
+         zero? x => s2
+         while not zero?(s2.generator) repeat
+            qr:= divide(s1.generator, s2.generator)
+            s3:=[s1.coef1 - qr.quotient * s2.coef1,
+                 s1.coef2 - qr.quotient * s2.coef2, qr.remainder]$IdealElt
+            s1:=s2
+            s2:=unitNormalizeIdealElt s3
+         if not(zero?(s1.coef1)) and not sizeLess?(s1.coef1,y)
+           then
+              qr:= divide(s1.coef1,y)
+              s1.coef1:= qr.remainder
+              s1.coef2:= s1.coef2 + qr.quotient * x
+              s1 := unitNormalizeIdealElt s1
+         s1
+
+      TwoCoefs ==> Record(coef1:%,coef2:%)
+
+      extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
+      extendedEuclidean(x,y,z) ==
+         zero? z => [0,0]$TwoCoefs
+         s:= extendedEuclidean(x,y)
+         (w:= z exquo s.generator) case "failed" => "failed"
+         zero? y => [s.coef1 * w, s.coef2 * w]$TwoCoefs
+         qr:= divide((s.coef1 * w), y)
+         [qr.remainder, s.coef2 * w + qr.quotient * x]$TwoCoefs
+
+      principalIdeal : List(%) -> Record(coef: List(%),generator: %)
+      principalIdeal l ==
+         l = [] => error "empty list passed to principalIdeal"
+         rest l = [] =>
+              uca:=unitNormal(first l)
+              [[uca.unit],uca.canonical]
+         rest rest l = [] =>
+             u:= extendedEuclidean(first l,second l)
+             [[u.coef1, u.coef2], u.generator]
+         v:=principalIdeal rest l
+         u:= extendedEuclidean(first l,v.generator)
+         [[u.coef1,:[u.coef2*vv for vv in v.coef]],u.generator]
+
+      expressIdealMember : (List(%),%) -> Union(List(%),"failed")
+      expressIdealMember(l,z) ==
+         z = 0 => [0 for v in l]
+         pid := principalIdeal l
+         (q := z exquo (pid.generator)) case "failed" => "failed"
+         [q*v for v in pid.coef]
+
+      multiEuclidean : (List(%),%) -> Union(List(%),"failed")
+      multiEuclidean(l,z) ==
+         n := #l
+         zero? n => error "empty list passed to multiEuclidean"
+         n = 1 => [z]
+         l1 := copy l
+         l2 := split!(l1, n quo 2)
+         u:= extendedEuclidean(*/l1, */l2, z)
+         u case "failed" => "failed"
+         v1 := multiEuclidean(l1,u.coef2)
+         v1 case "failed" => "failed"
+         v2 := multiEuclidean(l2,u.coef1)
+         v2 case "failed" => "failed"
+         concat(v1,v2)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{EUCDOM.dotabb}
 "EUCDOM"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=EUCDOM"];
 "EUCDOM" -> "PID"
 
 \end{chunk}
+
 \begin{chunk}{EUCDOM.dotfull}
 "EuclideanDomain()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=EUCDOM"];
 "EuclideanDomain()" -> "PrincipalIdealDomain()"
 
 \end{chunk}
+
 \begin{chunk}{EUCDOM.dotpic}
 digraph pic {
  fontsize=10;
@@ -54770,6 +62346,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{MultivariateTaylorSeriesCategory}{MTSCAT}
 \pagepic{ps/v102multivariatetaylorseriescategory.ps}{MTSCAT}{1.00}
@@ -54882,6 +62459,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{MultivariateTaylorSeriesCategory.help}
 ====================================================================
 MultivariateTaylorSeriesCategory examples
@@ -55191,6 +62769,7 @@ MultivariateTaylorSeriesCategory(Coef,Var): Category == Definition where
         --++ coefficients by integers.
 
 \end{chunk}
+
 \begin{chunk}{MTSCAT.dotabb}
 "MTSCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MTSCAT"];
@@ -55200,6 +62779,7 @@ MultivariateTaylorSeriesCategory(Coef,Var): Category == Definition where
 "MTSCAT" -> "EVALAB"
 
 \end{chunk}
+
 \begin{chunk}{MTSCAT.dotfull}
 "MultivariateTaylorSeriesCategory(a:Ring,b:OrderedSet)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MTSCAT"];
@@ -55213,6 +62793,7 @@ MultivariateTaylorSeriesCategory(Coef,Var): Category == Definition where
  "Evalable(MultivariateTaylorSeriesCategory(a:Ring,b:OrderedSet))"
 
 \end{chunk}
+
 \begin{chunk}{MTSCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -55237,6 +62818,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PolynomialFactorizationExplicit}{PFECAT}
 \pagepic{ps/v102polynomialfactorizationexplicit.ps}{PFECAT}{0.80}
@@ -55294,6 +62876,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PolynomialFactorizationExplicit.help}
 ====================================================================
 PolynomialFactorizationExplicit examples
@@ -55520,6 +63103,60 @@ PolynomialFactorizationExplicit(): Category == Definition where
                solveLinearPolynomialEquationByFractions(lf,g)$LPE
 
 \end{chunk}
+
+\begin{chunk}{COQ PFECAT}
+(* category PFECAT *)
+(*
+
+        gcdPolynomial :
+          (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) ->
+             SparseUnivariatePolynomial(%)
+        gcdPolynomial(f,g) ==
+           zero? f => g
+           zero? g => f
+           cf:=content f
+           if not one? cf then f:=(f exquo cf)::P
+           cg:=content g
+           if not one? cg then g:=(g exquo cg)::P
+           ans:=subResultantGcd(f,g)$P
+           gcd(cf,cg)*(ans exquo content ans)::P
+
+        if % has CharacteristicNonZero then
+
+          charthRoot : % -> Union(%,"failed") if $ has CHARNZ
+          charthRoot f ==
+             -- to take p'th root of f, solve the system X-fY=0,
+             -- so solution is [x,y]
+             -- with x^p=X and y^p=Y, then (x/y)^p = f
+             zero? f => 0
+             m:Matrix % := matrix [[1,-f]]
+             ans:= conditionP m
+             ans case "failed" => "failed"
+             (ans.1) exquo (ans.2)
+
+        if % has Field then
+
+          solveLinearPolynomialEquation :
+             (List(SparseUnivariatePolynomial(%)),
+              SparseUnivariatePolynomial(%)) ->
+                Union(List(SparseUnivariatePolynomial(%)),"failed")
+          solveLinearPolynomialEquation(lf,g) ==
+            multiEuclidean(lf,g)$P
+
+        else
+
+          solveLinearPolynomialEquation :
+             (List(SparseUnivariatePolynomial(%)),
+              SparseUnivariatePolynomial(%)) ->
+                Union(List(SparseUnivariatePolynomial(%)),"failed")
+          solveLinearPolynomialEquation(lf,g) ==
+               LPE ==> LinearPolynomialEquationByFractions %
+               solveLinearPolynomialEquationByFractions(lf,g)$LPE
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{PFECAT.dotabb}
 "PFECAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PFECAT"];
@@ -55654,6 +63291,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{UnivariatePowerSeriesCategory.help}
 ====================================================================
 UnivariatePowerSeriesCategory examples
@@ -55972,12 +63610,51 @@ UnivariatePowerSeriesCategory(Coef,Expon): Category == Definition where
     variables f == list create()
 
 \end{chunk}
+
+\begin{chunk}{COQ UPSCAT}
+(* category UPSCAT *)
+(*
+
+    degree : % -> Expon
+    degree f == order f
+
+    leadingCoefficient : % -> Coef
+    leadingCoefficient f == coefficient(f,order f)
+
+    leadingMonomial : % -> %
+    leadingMonomial f ==
+      ord := order f
+      monomial(coefficient(f,ord),ord)
+
+    monomial : (%,List(SingletonAsOrderedSet),List(Expon)) -> %
+    monomial(f:%,listVar:List SingletonAsOrderedSet,listExpon:List Expon) ==
+      empty? listVar or not empty? rest listVar =>
+        error "monomial: variable list must have exactly one entry"
+      empty? listExpon or not empty? rest listExpon =>
+        error "monomial: exponent list must have exactly one entry"
+      f * monomial(1,first listExpon)
+
+    monomial : (%,SingletonAsOrderedSet,Expon) -> %
+    monomial(f:%,v:SingletonAsOrderedSet,n:Expon) ==
+      f * monomial(1,n)
+
+    reductum : % -> %
+    reductum f == f - leadingMonomial f
+
+    variables : % -> List(SingletonAsOrderedSet)
+    variables f == list create()
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{UPSCAT.dotabb}
 "UPSCAT" 
  [color=lightblue,href="bookvol10.2.pdf#nameddest=UPSCAT"];
 "UPSCAT" -> "PSCAT"
 
 \end{chunk}
+
 \begin{chunk}{UPSCAT.dotfull}
 "UnivariatePowerSeriesCategory(a:Ring,b:OrderedAbelianMonoid)" 
  [color=lightblue,href="bookvol10.2.pdf#nameddest=UPSCAT"];
@@ -56000,6 +63677,7 @@ UnivariatePowerSeriesCategory(Coef,Expon): Category == Definition where
     "UnivariatePowerSeriesCategory(a:Ring,b:OrderedAbelianMonoid)"
 
 \end{chunk}
+
 \begin{chunk}{UPSCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -56066,6 +63744,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 15}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{Field}{FIELD}
@@ -56130,6 +63809,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{Field.help}
 ====================================================================
 Field examples
@@ -56364,6 +64044,61 @@ Field(): Category == Join(EuclideanDomain,UniqueFactorizationDomain,
       divide(x,y) == [x / y,0]
 
 \end{chunk}
+
+\begin{chunk}{COQ FIELD}
+(* category FIELD *)
+(*
+Axioms
+  a*(b/a) = b
+  inv(a) = 1/a
+
+
+      x,y: %
+      n: Integer
+
+      UCA ==> Record(unit:%,canonical:%,associate:%)
+
+      unitNormal : % -> Record(unit: %,canonical: %,associate: %)
+      unitNormal(x) ==
+          if zero? x then [1$%,0$%,1$%]$UCA else [x,1$%,inv(x)]$UCA
+
+      unitCanonical : % -> %
+      unitCanonical(x) == if zero? x then x else 1
+
+      associates? : (%,%) -> Boolean
+      associates?(x,y) == if zero? x then zero? y else not(zero? y)
+
+      inv : % -> %
+      inv x ==((u:=recip x) case "failed" => error "not invertible"; u)
+
+      exquo : (%,%) -> Union(%,"failed")
+      x exquo y == (y=0 => "failed"; x / y)
+
+      gcd : (%,%) -> %
+      gcd(x,y) == 1
+
+      euclideanSize : % -> NonNegativeInteger
+      euclideanSize(x) == 0
+
+      prime? : % -> Boolean
+      prime? x == false
+
+      squareFree : % -> Factored(%)
+      squareFree x == x::Factored(%)
+
+      factor : % -> Factored(%)
+      factor x == x::Factored(%)
+
+      ?/? : (%,%) -> %
+      x / y == (zero? y => error "catdef: division by zero"; x * inv(y))
+
+      divide : (%,%) -> Record(quotient: %,remainder: %)
+      divide(x,y) == [x / y,0]
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FIELD.dotabb}
 "FIELD"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FIELD"];
@@ -56372,6 +64107,7 @@ Field(): Category == Join(EuclideanDomain,UniqueFactorizationDomain,
 "FIELD" -> "DIVRING"
 
 \end{chunk}
+
 \begin{chunk}{FIELD.dotfull}
 "Field()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FIELD"];
@@ -56380,6 +64116,7 @@ Field(): Category == Join(EuclideanDomain,UniqueFactorizationDomain,
 "Field()" -> "DivisionRing()"
 
 \end{chunk}
+
 \begin{chunk}{FIELD.dotpic}
 digraph pic {
  fontsize=10;
@@ -56405,6 +64142,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{IntegerNumberSystem}{INS}
 \pagepic{ps/v102integernumbersystem.ps}{INS}{0.30}
@@ -56494,6 +64232,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{IntegerNumberSystem.help}
 ====================================================================
 IntegerNumberSystem examples
@@ -56927,7 +64666,6 @@ IntegerNumberSystem(): Category ==
          r1 := c1-q*d1
          c := d; c1 := d1
          d := r; d1 := r1
---      not one? c => error "inverse does not exist"
       not (c = 1) => error "inverse does not exist"
       negative? c1 => c1 + b
       c1
@@ -56944,6 +64682,140 @@ IntegerNumberSystem(): Category ==
          z := mulmod(z, z, p)
 
 \end{chunk}
+
+\begin{chunk}{COQ INS}
+(* category INS *)
+(*
+
+   characteristic : () -> NonNegativeInteger
+   characteristic() == 0
+
+   differentiate : % -> %
+   differentiate x == 0
+
+   even? : % -> Boolean
+   even? x == not odd? x
+
+   positive? : % -> Boolean
+   positive? x == x > 0
+
+   copy : % -> %
+   copy x == x
+
+   bit? : (%,%) -> Boolean
+   bit?(x, i) == odd? shift(x, -i)
+
+   mask : % -> %
+   mask n == dec shift(1, n)
+
+   rational? : % -> Boolean
+   rational? x == true
+
+   euclideanSize : % -> NonNegativeInteger
+   euclideanSize(x) ==
+        x=0 => error "euclideanSize called on zero"
+        x<0 => (-convert(x)@Integer)::NonNegativeInteger
+        convert(x)@Integer::NonNegativeInteger
+
+   convert : % -> Float
+   convert(x:%):Float == (convert(x)@Integer)::Float
+
+   convert : % -> DoubleFloat
+   convert(x:%):DoubleFloat  == (convert(x)@Integer)::DoubleFloat
+
+   convert : % -> InputForm
+   convert(x:%):InputForm == convert(convert(x)@Integer)
+
+   retract(x:%):Integer == convert(x)@Integer
+
+   convert : % -> Pattern(Integer)
+   convert(x:%):Pattern(Integer)== convert(x)@Integer ::Pattern(Integer)
+
+   factor : % -> Factored(%)
+   factor x == factor(x)$IntegerFactorizationPackage(%)
+
+   squareFree : % -> Factored(%)
+   squareFree x == squareFree(x)$IntegerFactorizationPackage(%)
+
+   prime? : % -> Boolean
+   prime? x == prime?(x)$IntegerPrimesPackage(%)
+
+   factorial : % -> %
+   factorial x == factorial(x)$IntegerCombinatoricFunctions(%)
+
+   binomial : (%,%) -> %
+   binomial(n, m) == binomial(n, m)$IntegerCombinatoricFunctions(%)
+
+   permutation : (%,%) -> %
+   permutation(n, m) == permutation(n,m)$IntegerCombinatoricFunctions(%)
+
+   rationalIfCan : % -> Union(Fraction(Integer),"failed")
+   retractIfCan(x:%):Union(Integer, "failed") == convert(x)@Integer
+
+   init : () -> %
+   init() == 0
+
+   -- iterates in order 0,1,-1,2,-2,3,-3,...
+   nextItem : % -> Union(%,"failed")
+   nextItem(n) ==
+     zero? n => 1
+     n>0 => -n
+     1-n
+
+   patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) ->
+      PatternMatchResult(Integer,%)
+   patternMatch(x, p, l) ==
+     patternMatch(x, p, l)$PatternMatchIntegerNumberSystem(%)
+
+   rational : % -> Fraction(Integer)
+   rational(x:%):Fraction(Integer) ==
+     (convert(x)@Integer)::Fraction(Integer)
+
+   rationalIfCan : % -> Union(Fraction(Integer),"failed")
+   rationalIfCan(x:%):Union(Fraction Integer, "failed") ==
+     (convert(x)@Integer)::Fraction(Integer)
+
+   symmetricRemainder : (%,%) -> %
+   symmetricRemainder(x, n) ==
+      r := x rem n
+      r = 0 => r
+      if n < 0 then n:=-n
+      r > 0 =>
+         2 * r > n => r - n
+         r
+      2*r + n <= 0 => r + n
+      r
+
+   invmod : (%,%) -> %
+   invmod(a, b) ==
+      if negative? a then a := positiveRemainder(a, b)
+      c := a; c1:% := 1
+      d := b; d1:% := 0
+      while not zero? d repeat
+         q := c quo d
+         r := c-q*d
+         r1 := c1-q*d1
+         c := d; c1 := d1
+         d := r; d1 := r1
+      not (c = 1) => error "inverse does not exist"
+      negative? c1 => c1 + b
+      c1
+
+   powmod : (%,%,%) -> %
+   powmod(x, n, p) ==
+      if negative? x then x := positiveRemainder(x, p)
+      zero? x => 0
+      zero? n => 1
+      y:% := 1
+      z := x
+      repeat
+         if odd? n then y := mulmod(y, z, p)
+         zero?(n := shift(n, -1)) => return y
+         z := mulmod(z, z, p)
+*)
+
+\end{chunk}
+
 \begin{chunk}{INS.dotabb}
 "INS"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=INS"];
@@ -57123,6 +64995,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{LocalPowerSeriesCategory.help}
 ====================================================================
 LocalPowerSeriesCategory examples
@@ -57454,12 +65327,14 @@ LocalPowerSeriesCategory(K:Field):Category == Implementation where
         ++ returns the value of the \spad{printInfo} flag.
 
 \end{chunk}
+
 \begin{chunk}{LOCPOWC.dotabb}
 "LOCPOWC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LOCPOWC"];
 "LOCPOWC" -> "UPSCAT"
 
 \end{chunk}
+
 \begin{chunk}{LOCPOWC.dotfull}
 "LocalPowerSeriesCategory(f:Field)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=LOCPOWC"];
@@ -57467,6 +65342,7 @@ LocalPowerSeriesCategory(K:Field):Category == Implementation where
   "UnivariatePowerSeriesCategory(c:Ring,e:OrderedAbelianMonoid)"
 
 \end{chunk}
+
 \begin{chunk}{LOCPOWC.dotpic}
 digraph pic {
  fontsize=10;
@@ -57742,6 +65618,7 @@ PAdicIntegerCategory(p): Category == Definition where
       ++ Argument \spad{a} must be a root of \spad{f} \spad{(mod p)}.
 
 \end{chunk}
+
 \begin{chunk}{PADICCT.dotabb}
 "PADICCT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PADICCT"];
@@ -57749,6 +65626,7 @@ PAdicIntegerCategory(p): Category == Definition where
 "PADICCT" -> "EUCDOM"
 
 \end{chunk}
+
 \begin{chunk}{PADICCT.dotfull}
 "PAdicIntegerCategory(a:Integer)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PADICCT"];
@@ -57756,6 +65634,7 @@ PAdicIntegerCategory(p): Category == Definition where
 "PAdicIntegerCategory(a:Integer)" -> "EuclideanDomain()"
 
 \end{chunk}
+
 \begin{chunk}{PADICCT.dotpic}
 digraph pic {
  fontsize=10;
@@ -57803,6 +65682,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PolynomialCategory}{POLYCAT}
 \pagepic{ps/v102polynomialcategory.ps}{POLYCAT}{0.40}
@@ -57937,6 +65817,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PolynomialCategory.help}
 ====================================================================
 PolynomialCategory examples
@@ -58485,9 +66366,6 @@ PolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, VarSet:OrderedSet):
       eval(p, lvar,[rhs e for e in l]$List(%))
 
     monomials p ==
---    zero? p => empty()
---    concat(leadingMonomial p, monomials reductum p)
---    replaced by sequential version for efficiency, by WMSIT, 7/30/90
       ml:= empty$List(%)
       while p ^= 0 repeat
         ml:=concat(leadingMonomial p, ml)
@@ -58501,7 +66379,6 @@ PolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, VarSet:OrderedSet):
     isTimes p ==
       empty?(lv := variables p) or not monomial? p => "failed"
       l := [monomial(1, v, degree(p, v)) for v in lv]
---      one?(r := leadingCoefficient p) =>
       ((r := leadingCoefficient p) = 1) =>
         empty? rest lv => "failed"
         l
@@ -58771,254 +66648,628 @@ PolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, VarSet:OrderedSet):
                     p)$PolynomialCategoryLifting(E,VarSet,R,%,InputForm)
 
 \end{chunk}
-\begin{chunk}{POLYCAT.dotabb}
-"POLYCAT"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"];
-"POLYCAT" -> "PDRING"
-"POLYCAT" -> "FAMR"
-"POLYCAT" -> "EVALAB"
-"POLYCAT" -> "IEVALAB"
-"POLYCAT" -> "RETRACT"
-"POLYCAT" -> "FLINEXP"
-"POLYCAT" -> "ORDSET"
-"POLYCAT" -> "GCDDOM"
-"POLYCAT" -> "PFECAT"
 
-\end{chunk}
-\begin{chunk}{POLYCAT.dotfull}
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"];
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "PartialDifferentialRing(a:OrderedSet)"
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "FiniteAbelianMonoidRing(a:Ring,b:OrderedAbelianMonoidSup)"
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "Evalable(PolynomialCategory(...))"
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "InnerEvalable(a:OrderedSet,b:Ring)"
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "InnerEvalable(a:OrderedSet,b:PolynomialCategory(...))"
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "RetractableTo(a:OrderedSet)"
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "FullyLinearlyExplicitRingOver(a:Ring)"
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "OrderedSet()"
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "GcdDomain()"
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "PolynomialFactorizationExplicit()"
+\begin{chunk}{COQ POLYCAT}
+(* category POLYCAT *)
+(*
+    p:%
+    v:VarSet
+    ln:List NonNegativeInteger
+    lv:List VarSet
+    n:NonNegativeInteger
+    pp,qq:SparseUnivariatePolynomial %
 
-"PolynomialCategory(a:Ring,b:NonNegativeInteger,c:SingletonAsOrderedSet)"
- [color=seagreen,href="bookvol10.2.pdf#nameddest=POLYCAT"];
-"PolynomialCategory(a:Ring,b:NonNegativeInteger,c:SingletonAsOrderedSet)"
- -> "PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-\end{chunk}
-\begin{chunk}{POLYCAT.dotpic}
-digraph pic {
- fontsize=10;
- bgcolor="#ECEA81";
- node [shape=box, color=white, style=filled];
+    eval : (%,List(Equation(%))) -> %
+    eval(p:%, l:List Equation %) ==
+      empty? l => p
+      for e in l repeat
+        retractIfCan(lhs e)@Union(VarSet,"failed") case "failed" => 
+             error "cannot find a variable to evaluate"
+      lvar:=[retract(lhs e)@VarSet for e in l]
+      eval(p, lvar,[rhs e for e in l]$List(%))
 
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"];
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "PDRING..."
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "FAMR..."
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "EVALAB..."
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "IEVALAB..."
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "RETRACT..."
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "FLINEXP..."
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "ORDSET..."
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "GCDDOM..."
-"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
-  -> "PFECAT..."
+    monomials : % -> List(%)
+    monomials p ==
+      ml:= empty$List(%)
+      while p ^= 0 repeat
+        ml:=concat(leadingMonomial p, ml)
+        p:= reductum p
+      reverse ml
 
-"PDRING..." [color=lightblue];
-"FAMR..." [color=lightblue];
-"EVALAB..." [color=lightblue];
-"IEVALAB..." [color=lightblue];
-"RETRACT..." [color=lightblue];
-"FLINEXP..." [color=lightblue];
-"ORDSET..." [color=lightblue];
-"GCDDOM..." [color=lightblue];
-"PFECAT..." [color=lightblue];
+    isPlus : % -> Union(List(%),"failed")
+    isPlus p ==
+      empty? rest(l := monomials p) => "failed"
+      l
 
-}
+    isTimes : % -> Union(List(%),"failed")
+    isTimes p ==
+      empty?(lv := variables p) or not monomial? p => "failed"
+      l := [monomial(1, v, degree(p, v)) for v in lv]
+      ((r := leadingCoefficient p) = 1) =>
+        empty? rest lv => "failed"
+        l
+      concat(r::%, l)
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\pagehead{UnivariateTaylorSeriesCategory}{UTSCAT}
-\pagepic{ps/v102univariatetaylorseriescategory.ps}{UTSCAT}{0.60}
+    isExpt : % ->
+       Union(Record(var: VarSet,exponent: NonNegativeInteger),"failed")
+    isExpt p ==
+      (u := mainVariable p) case "failed" => "failed"
+      p = monomial(1, u::VarSet, d := degree(p, u::VarSet)) =>
+        [u::VarSet, d]
+      "failed"
 
-\begin{chunk}{UnivariateTaylorSeriesCategory.input}
-)set break resume
-)sys rm -f UnivariateTaylorSeriesCategory.output
-)spool UnivariateTaylorSeriesCategory.output
-)set message test on
-)set message auto off
-)clear all
+    coefficient : (%,VarSet,NonNegativeInteger) -> %
+    coefficient(p,v,n) == coefficient(univariate(p,v),n)
 
---S 1 of 1
-)show UnivariateTaylorSeriesCategory
---R 
---R UnivariateTaylorSeriesCategory(Coef: Ring)  is a category constructor
---R Abbreviation for UnivariateTaylorSeriesCategory is UTSCAT 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.2.pamphlet to see algebra source code for UTSCAT 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (Coef,%) -> %                   ?*? : (%,Coef) -> %
---R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
---R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
---R -? : % -> %                           ?=? : (%,%) -> Boolean
---R 1 : () -> %                           0 : () -> %
---R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R center : % -> Coef                    coefficients : % -> Stream(Coef)
---R coerce : % -> % if Coef has INTDOM    coerce : Integer -> %
---R coerce : % -> OutputForm              complete : % -> %
---R degree : % -> NonNegativeInteger      hash : % -> SingleInteger
---R latex : % -> String                   leadingCoefficient : % -> Coef
---R leadingMonomial : % -> %              map : ((Coef -> Coef),%) -> %
---R monomial? : % -> Boolean              one? : % -> Boolean
---R order : % -> NonNegativeInteger       pole? : % -> Boolean
---R quoByVar : % -> %                     recip : % -> Union(%,"failed")
---R reductum : % -> %                     sample : () -> %
---R series : Stream(Coef) -> %            variable : % -> Symbol
---R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
---R ?*? : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT))
---R ?*? : (Fraction(Integer),%) -> % if Coef has ALGEBRA(FRAC(INT))
---R ?**? : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT))
---R ?**? : (%,%) -> % if Coef has ALGEBRA(FRAC(INT))
---R ?**? : (%,Coef) -> % if Coef has FIELD
---R ?/? : (%,Coef) -> % if Coef has FIELD
---R D : % -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef
---R D : (%,NonNegativeInteger) -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef
---R D : (%,Symbol) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
---R D : (%,List(Symbol)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
---R D : (%,Symbol,NonNegativeInteger) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
---R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
---R acos : % -> % if Coef has ALGEBRA(FRAC(INT))
---R acosh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R acot : % -> % if Coef has ALGEBRA(FRAC(INT))
---R acoth : % -> % if Coef has ALGEBRA(FRAC(INT))
---R acsc : % -> % if Coef has ALGEBRA(FRAC(INT))
---R acsch : % -> % if Coef has ALGEBRA(FRAC(INT))
---R approximate : (%,NonNegativeInteger) -> Coef if Coef has **: (Coef,NonNegativeInteger) -> Coef and Coef has coerce: Symbol -> Coef
---R asec : % -> % if Coef has ALGEBRA(FRAC(INT))
---R asech : % -> % if Coef has ALGEBRA(FRAC(INT))
---R asin : % -> % if Coef has ALGEBRA(FRAC(INT))
---R asinh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R associates? : (%,%) -> Boolean if Coef has INTDOM
---R atan : % -> % if Coef has ALGEBRA(FRAC(INT))
---R atanh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R characteristic : () -> NonNegativeInteger
---R charthRoot : % -> Union(%,"failed") if Coef has CHARNZ
---R coefficient : (%,NonNegativeInteger) -> Coef
---R coerce : Coef -> % if Coef has COMRING
---R coerce : Fraction(Integer) -> % if Coef has ALGEBRA(FRAC(INT))
---R cos : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cosh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cot : % -> % if Coef has ALGEBRA(FRAC(INT))
---R coth : % -> % if Coef has ALGEBRA(FRAC(INT))
---R csc : % -> % if Coef has ALGEBRA(FRAC(INT))
---R csch : % -> % if Coef has ALGEBRA(FRAC(INT))
---R differentiate : % -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef
---R differentiate : (%,NonNegativeInteger) -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef
---R differentiate : (%,Symbol) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
---R differentiate : (%,List(Symbol)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
---R differentiate : (%,Symbol,NonNegativeInteger) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
---R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
---R ?.? : (%,%) -> % if NonNegativeInteger has SGROUP
---R ?.? : (%,NonNegativeInteger) -> Coef
---R eval : (%,Coef) -> Stream(Coef) if Coef has **: (Coef,NonNegativeInteger) -> Coef
---R exp : % -> % if Coef has ALGEBRA(FRAC(INT))
---R exquo : (%,%) -> Union(%,"failed") if Coef has INTDOM
---R extend : (%,NonNegativeInteger) -> %
---R integrate : (%,Symbol) -> % if Coef has ACFS(INT) and Coef has PRIMCAT and Coef has TRANFUN and Coef has ALGEBRA(FRAC(INT)) or Coef has variables: Coef -> List(Symbol) and Coef has integrate: (Coef,Symbol) -> Coef and Coef has ALGEBRA(FRAC(INT))
---R integrate : % -> % if Coef has ALGEBRA(FRAC(INT))
---R log : % -> % if Coef has ALGEBRA(FRAC(INT))
---R monomial : (%,List(SingletonAsOrderedSet),List(NonNegativeInteger)) -> %
---R monomial : (%,SingletonAsOrderedSet,NonNegativeInteger) -> %
---R monomial : (Coef,NonNegativeInteger) -> %
---R multiplyCoefficients : ((Integer -> Coef),%) -> %
---R multiplyExponents : (%,PositiveInteger) -> %
---R nthRoot : (%,Integer) -> % if Coef has ALGEBRA(FRAC(INT))
---R order : (%,NonNegativeInteger) -> NonNegativeInteger
---R pi : () -> % if Coef has ALGEBRA(FRAC(INT))
---R polynomial : (%,NonNegativeInteger,NonNegativeInteger) -> Polynomial(Coef)
---R polynomial : (%,NonNegativeInteger) -> Polynomial(Coef)
---R sec : % -> % if Coef has ALGEBRA(FRAC(INT))
---R sech : % -> % if Coef has ALGEBRA(FRAC(INT))
---R series : Stream(Record(k: NonNegativeInteger,c: Coef)) -> %
---R sin : % -> % if Coef has ALGEBRA(FRAC(INT))
---R sinh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R sqrt : % -> % if Coef has ALGEBRA(FRAC(INT))
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R tan : % -> % if Coef has ALGEBRA(FRAC(INT))
---R tanh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R terms : % -> Stream(Record(k: NonNegativeInteger,c: Coef))
---R truncate : (%,NonNegativeInteger,NonNegativeInteger) -> %
---R truncate : (%,NonNegativeInteger) -> %
---R unit? : % -> Boolean if Coef has INTDOM
---R unitCanonical : % -> % if Coef has INTDOM
---R unitNormal : % -> Record(unit: %,canonical: %,associate: %) if Coef has INTDOM
---R variables : % -> List(SingletonAsOrderedSet)
---R
---E 1
+    coefficient : (%,List(VarSet),List(NonNegativeInteger)) -> %
+    coefficient(p,lv,ln) ==
+       empty? lv =>
+         empty? ln => p
+         error "mismatched lists in coefficient"
+       empty? ln  => error "mismatched lists in coefficient"
+       coefficient(coefficient(univariate(p,first lv),first ln),
+                   rest lv,rest ln)
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{UnivariateTaylorSeriesCategory.help}
-====================================================================
-UnivariateTaylorSeriesCategory examples
-====================================================================
+    monomial : (%,List(VarSet),List(NonNegativeInteger)) -> %
+    monomial(p,lv,ln) ==
+       empty? lv =>
+         empty? ln => p
+         error "mismatched lists in monomial"
+       empty? ln  => error "mismatched lists in monomial"
+       monomial(monomial(p,first lv, first ln),rest lv, rest ln)
 
-UnivariateTaylorSeriesCategory is the category of Taylor series 
-in one variable.
+    retract : % -> VarSet
+    retract(p:%):VarSet ==
+      q := mainVariable(p)::VarSet
+      q::% = p => q
+      error "Polynomial is not a single variable"
 
-See Also:
-o )show UnivariateTaylorSeriesCategory
+    retractIfCan : % -> Union(VarSet,"failed")
+    retractIfCan(p:%):Union(VarSet, "failed") ==
+      ((q := mainVariable p) case VarSet) and (q::VarSet::% = p) => q
+      "failed"
 
-\end{chunk}
-{\bf See:}
+    mkPrim: % -> %
+    mkPrim(p:%):% == monomial(1,degree p)
 
-\pagefrom{RadicalCategory}{RADCAT}
-\pagefrom{TranscendentalFunctionCategory}{TRANFUN}
-\pagefrom{UnivariatePowerSeriesCategory}{UPSCAT}
+    primitiveMonomials : % -> List(%)
+    primitiveMonomials p == [mkPrim q for q in monomials p]
 
-{\bf Exports:}\\
+    totalDegree : % -> NonNegativeInteger
+    totalDegree p ==
+        ground? p => 0
+        u := univariate(p, mainVariable(p)::VarSet)
+        d: NonNegativeInteger := 0
+        while u ^= 0 repeat
+          d := max(d, degree u + totalDegree leadingCoefficient u)
+          u := reductum u
+        d
 
-\begin{tabular}{llll}
-\cross{UTSCAT}{0} &
-\cross{UTSCAT}{1} &
-\cross{UTSCAT}{acos} &
-\cross{UTSCAT}{acosh} \\
-\cross{UTSCAT}{acot} &
-\cross{UTSCAT}{acoth} &
-\cross{UTSCAT}{acsc} &
-\cross{UTSCAT}{acsch} \\
-\cross{UTSCAT}{approximate} &
-\cross{UTSCAT}{asec} &
-\cross{UTSCAT}{asech} &
-\cross{UTSCAT}{asin} \\
-\cross{UTSCAT}{asinh} &
-\cross{UTSCAT}{associates?} &
-\cross{UTSCAT}{atan} &
-\cross{UTSCAT}{atanh} \\
-\cross{UTSCAT}{center} &
-\cross{UTSCAT}{characteristic} &
-\cross{UTSCAT}{charthRoot} &
+    totalDegree : (%,List(VarSet)) -> NonNegativeInteger
+    totalDegree(p,lv) ==
+        ground? p => 0
+        u := univariate(p, v:=(mainVariable(p)::VarSet))
+        d: NonNegativeInteger := 0
+        w: NonNegativeInteger := 0
+        if member?(v, lv) then w:=1
+        while u ^= 0 repeat
+          d := max(d, w*(degree u) + totalDegree(leadingCoefficient u,lv))
+          u := reductum u
+        d
+
+    if R has CommutativeRing then
+
+        resultant : (%,%,VarSet) -> % if R has COMRING
+        resultant(p1,p2,mvar) ==
+          resultant(univariate(p1,mvar),univariate(p2,mvar))
+
+        differentiate : (%,VarSet) -> %
+        discriminant(p,var) ==
+          discriminant(univariate(p,var))
+
+    if R has IntegralDomain then
+
+      allMonoms: List(%) -> List(%)
+      allMonoms(l:List %):List(%) ==
+        removeDuplicates_! concat [primitiveMonomials p for p in l]
+
+      P2R: (%, List(E), NonNegativeInteger) -> Vector(R)
+      P2R(p:%, b:List E, n:NonNegativeInteger):Vector(R) ==
+        w := new(n, 0)$Vector(R)
+        for i in minIndex w .. maxIndex w for bj in b repeat
+          qsetelt_!(w, i, coefficient(p, bj))
+        w
+
+      eq2R: (List(%), List(E)) -> Matrix(R)
+      eq2R(l:List %, b:List E):Matrix(R) ==
+        matrix [[coefficient(p, bj) for p in l] for bj in b]
+
+      reducedSystem : Matrix(%) -> Matrix(R)
+      reducedSystem(m:Matrix %):Matrix(R) ==
+        l := listOfLists m
+        b := removeDuplicates_!
+                           concat [allMonoms r for r in l]$List(List(%))
+        d := [degree bj for bj in b]
+        mm := eq2R(first l, d)
+        l := rest l
+        while not empty? l repeat
+          mm := vertConcat(mm, eq2R(first l, d))
+          l := rest l
+        mm
+
+      reducedSystem : (Matrix(%),Vector(%)) ->
+       Record(mat: Matrix(R),vec: Vector(R))
+      reducedSystem(m:Matrix %, v:Vector %):
+       Record(mat:Matrix R, vec:Vector R) ==
+        l := listOfLists m
+        r := entries v
+        b : List % := removeDuplicates_! concat(allMonoms r,
+                          concat [allMonoms s for s in l]$List(List(%)))
+        d := [degree bj for bj in b]
+        n := #d
+        mm := eq2R(first l, d)
+        w := P2R(first r, d, n)
+        l := rest l
+        r := rest r
+        while not empty? l repeat
+          mm := vertConcat(mm, eq2R(first l, d))
+          w := concat(w, P2R(first r, d, n))
+          l := rest l
+          r := rest r
+        [mm, w]
+
+    if R has PolynomialFactorizationExplicit then
+       -- we might be in trouble if its actually only
+       -- a univariate polynomial category - have to remember to
+       -- over-ride these in UnivariatePolynomialCategory
+
+       PFBR ==>PolynomialFactorizationByRecursion(R,E,VarSet,%)
+
+       gcdPolynomial : (SparseUnivariatePolynomial(%),
+                        SparseUnivariatePolynomial(%)) ->
+                           SparseUnivariatePolynomial(%)
+       gcdPolynomial(pp,qq) ==
+          gcdPolynomial(pp,qq)$GeneralPolynomialGcdPackage(E,VarSet,R,%)
+
+       solveLinearPolynomialEquation :
+        (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) ->
+          Union(List(SparseUnivariatePolynomial(%)),"failed") if R has PFECAT
+       solveLinearPolynomialEquation(lpp,pp) ==
+         solveLinearPolynomialEquationByRecursion(lpp,pp)$PFBR
+
+       factorPolynomial : SparseUnivariatePolynomial(%) ->
+         Factored(SparseUnivariatePolynomial(%))
+       factorPolynomial(pp) ==
+         factorByRecursion(pp)$PFBR
+
+       factorSquareFreePolynomial : SparseUnivariatePolynomial(%) ->
+         Factored(SparseUnivariatePolynomial(%))
+       factorSquareFreePolynomial(pp) ==
+         factorSquareFreeByRecursion(pp)$PFBR
+
+       factor : % -> Factored(%)
+       factor p ==
+         v:Union(VarSet,"failed"):=mainVariable p
+         v case "failed" =>
+           ansR:=factor leadingCoefficient p
+           makeFR(unit(ansR)::%,
+                  [[w.flg,w.fctr::%,w.xpnt] for w in factorList ansR])
+         up:SparseUnivariatePolynomial %:=univariate(p,v)
+         ansSUP:=factorByRecursion(up)$PFBR
+         makeFR(multivariate(unit(ansSUP),v),
+                [[ww.flg,multivariate(ww.fctr,v),ww.xpnt]
+                 for ww in factorList ansSUP])
+       
+       if R has CharacteristicNonZero then
+
+          mat: Matrix %
+
+          conditionP : Matrix(%) -> Union(Vector(%),"failed")
+          conditionP mat ==
+            ll:=listOfLists transpose mat  --hence each list corresponds to a
+                                           --column, i.e. to one variable
+            llR:List List R := [ empty() for z in first ll]
+            monslist:List List % := empty()
+            ch:=characteristic()$%
+            for l in ll repeat
+                mons:= "setUnion"/[primitiveMonomials u for u in l]
+                redmons:List % :=[]
+                for m in mons repeat
+                    vars:=variables m
+                    degs:=degree(m,vars)
+                    deg1:List NonNegativeInteger
+                    deg1:=[ ((nd:=d:Integer exquo ch:Integer)
+                               case "failed" => return "failed" ;
+                                nd::Integer::NonNegativeInteger)
+                           for d in degs ]
+                    redmons:=[monomial(1,vars,deg1),:redmons]
+                    llR:=[[ground coefficient(u,vars,degs),:v]_
+                            for u in l for v in llR]
+                monslist:=[redmons,:monslist]
+            ans:=conditionP transpose matrix llR
+            ans case "failed" => "failed"
+            i:NonNegativeInteger:=0
+            [ +/[m*(ans.(i:=i+1))::% for m in mons ]
+              for mons in monslist]
+
+    if R has CharacteristicNonZero then
+
+          charthRoot : % -> Union(%,"failed")
+          charthRoot p ==
+            vars:= variables p
+            empty? vars =>
+              ans := charthRoot ground p
+              ans case "failed" => "failed"
+              ans::R::%
+            ch:=characteristic()$%
+            charthRootlv(p,vars,ch)
+
+          charthRootlv:(%,List VarSet,NonNegativeInteger) -> Union(%,"failed")
+          charthRootlv(p,vars,ch) ==
+            empty? vars =>
+              ans := charthRoot ground p
+              ans case "failed" => "failed"
+              ans::R::%
+            v:=first vars
+            vars:=rest vars
+            d:=degree(p,v)
+            ans:% := 0
+            while (d>0) repeat
+               (dd:=(d::Integer exquo ch::Integer)) case "failed" =>
+                      return "failed"
+               cp:=coefficient(p,v,d)
+               p:=p-monomial(cp,v,d)
+               ansx:=charthRootlv(cp,vars,ch)
+               ansx case "failed" => return "failed"
+               d:=degree(p,v)
+               ans:=ans+monomial(ansx,v,dd::Integer::NonNegativeInteger)
+            ansx:=charthRootlv(p,vars,ch)
+            ansx case "failed" => return "failed"
+            return ans+ansx
+
+    monicDivide : (%,%,VarSet) -> Record(quotient: %,remainder: %)
+    monicDivide(p1,p2,mvar) ==
+       result:=monicDivide(univariate(p1,mvar),univariate(p2,mvar))
+       [multivariate(result.quotient,mvar),
+        multivariate(result.remainder,mvar)]
+
+    if R has GcdDomain then
+
+      if R has EuclideanDomain and R has CharacteristicZero then
+
+       squareFree : % -> Factored(%)
+       squareFree p == squareFree(p)$MultivariateSquareFree(E,VarSet,R,%)
+
+      else
+
+        squareFree : % -> Factored(%)
+        squareFree p == squareFree(p)$PolynomialSquareFree(VarSet,E,R,%)
+
+      squareFreePart : % -> %
+      squareFreePart p ==
+        unit(s := squareFree p) * */[f.factor for f in factors s]
+
+      content : (%,VarSet) -> %
+      content(p,v) == content univariate(p,v)
+
+      primitivePart : % -> %
+      primitivePart p ==
+        zero? p => p
+        unitNormal((p exquo content p) ::%).canonical
+
+      primitivePart : (%,VarSet) -> %
+      primitivePart(p,v) ==
+        zero? p => p
+        unitNormal((p exquo content(p,v)) ::%).canonical
+
+    if R has OrderedSet then
+
+      ?<? : (%,%) -> Boolean
+      p:% < q:% ==
+        (dp:= degree p) < (dq := degree q) => (leadingCoefficient q) > 0
+        dq < dp => (leadingCoefficient p) < 0
+        leadingCoefficient(p - q) < 0
+
+      if (R has PatternMatchable Integer) and
+         (VarSet has PatternMatchable Integer) then
+
+           patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) ->
+               PatternMatchResult(Integer,%)
+           patternMatch(p:%, pat:Pattern Integer,
+            l:PatternMatchResult(Integer, %)) ==
+              patternMatch(p, pat,
+                l)$PatternMatchPolynomialCategory(Integer,E,VarSet,R,%)
+
+      if (R has PatternMatchable Float) and
+         (VarSet has PatternMatchable Float) then
+
+           patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) ->
+              PatternMatchResult(Float,%)
+           patternMatch(p:%, pat:Pattern Float,
+            l:PatternMatchResult(Float, %)) ==
+              patternMatch(p, pat,
+                l)$PatternMatchPolynomialCategory(Float,E,VarSet,R,%)
+
+    if (R has ConvertibleTo Pattern Integer) and
+       (VarSet has ConvertibleTo Pattern Integer) then
+
+         convert : % -> Pattern(Integer)
+         convert(x:%):Pattern(Integer) ==
+           map(convert, convert,
+              x)$PolynomialCategoryLifting(E,VarSet,R,%,Pattern Integer)
+
+    if (R has ConvertibleTo Pattern Float) and
+       (VarSet has ConvertibleTo Pattern Float) then
+
+         convert : % -> Pattern(Float)
+         convert(x:%):Pattern(Float) ==
+           map(convert, convert,
+            x)$PolynomialCategoryLifting(E, VarSet, R, %, Pattern Float)
+
+    if (R has ConvertibleTo InputForm) and
+       (VarSet has ConvertibleTo InputForm) then
+
+         convert : % -> InputForm
+         convert(p:%):InputForm ==
+           map(convert, convert,
+                    p)$PolynomialCategoryLifting(E,VarSet,R,%,InputForm)
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{POLYCAT.dotabb}
+"POLYCAT"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"];
+"POLYCAT" -> "PDRING"
+"POLYCAT" -> "FAMR"
+"POLYCAT" -> "EVALAB"
+"POLYCAT" -> "IEVALAB"
+"POLYCAT" -> "RETRACT"
+"POLYCAT" -> "FLINEXP"
+"POLYCAT" -> "ORDSET"
+"POLYCAT" -> "GCDDOM"
+"POLYCAT" -> "PFECAT"
+
+\end{chunk}
+
+\begin{chunk}{POLYCAT.dotfull}
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"];
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "PartialDifferentialRing(a:OrderedSet)"
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "FiniteAbelianMonoidRing(a:Ring,b:OrderedAbelianMonoidSup)"
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "Evalable(PolynomialCategory(...))"
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "InnerEvalable(a:OrderedSet,b:Ring)"
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "InnerEvalable(a:OrderedSet,b:PolynomialCategory(...))"
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "RetractableTo(a:OrderedSet)"
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "FullyLinearlyExplicitRingOver(a:Ring)"
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "OrderedSet()"
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "GcdDomain()"
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "PolynomialFactorizationExplicit()"
+
+"PolynomialCategory(a:Ring,b:NonNegativeInteger,c:SingletonAsOrderedSet)"
+ [color=seagreen,href="bookvol10.2.pdf#nameddest=POLYCAT"];
+"PolynomialCategory(a:Ring,b:NonNegativeInteger,c:SingletonAsOrderedSet)"
+ -> "PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+\end{chunk}
+
+\begin{chunk}{POLYCAT.dotpic}
+digraph pic {
+ fontsize=10;
+ bgcolor="#ECEA81";
+ node [shape=box, color=white, style=filled];
+
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=POLYCAT"];
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "PDRING..."
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "FAMR..."
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "EVALAB..."
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "IEVALAB..."
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "RETRACT..."
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "FLINEXP..."
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "ORDSET..."
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "GCDDOM..."
+"PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
+  -> "PFECAT..."
+
+"PDRING..." [color=lightblue];
+"FAMR..." [color=lightblue];
+"EVALAB..." [color=lightblue];
+"IEVALAB..." [color=lightblue];
+"RETRACT..." [color=lightblue];
+"FLINEXP..." [color=lightblue];
+"ORDSET..." [color=lightblue];
+"GCDDOM..." [color=lightblue];
+"PFECAT..." [color=lightblue];
+
+}
+
+\end{chunk}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\pagehead{UnivariateTaylorSeriesCategory}{UTSCAT}
+\pagepic{ps/v102univariatetaylorseriescategory.ps}{UTSCAT}{0.60}
+
+\begin{chunk}{UnivariateTaylorSeriesCategory.input}
+)set break resume
+)sys rm -f UnivariateTaylorSeriesCategory.output
+)spool UnivariateTaylorSeriesCategory.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show UnivariateTaylorSeriesCategory
+--R 
+--R UnivariateTaylorSeriesCategory(Coef: Ring)  is a category constructor
+--R Abbreviation for UnivariateTaylorSeriesCategory is UTSCAT 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.2.pamphlet to see algebra source code for UTSCAT 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (Coef,%) -> %                   ?*? : (%,Coef) -> %
+--R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
+--R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
+--R -? : % -> %                           ?=? : (%,%) -> Boolean
+--R 1 : () -> %                           0 : () -> %
+--R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
+--R center : % -> Coef                    coefficients : % -> Stream(Coef)
+--R coerce : % -> % if Coef has INTDOM    coerce : Integer -> %
+--R coerce : % -> OutputForm              complete : % -> %
+--R degree : % -> NonNegativeInteger      hash : % -> SingleInteger
+--R latex : % -> String                   leadingCoefficient : % -> Coef
+--R leadingMonomial : % -> %              map : ((Coef -> Coef),%) -> %
+--R monomial? : % -> Boolean              one? : % -> Boolean
+--R order : % -> NonNegativeInteger       pole? : % -> Boolean
+--R quoByVar : % -> %                     recip : % -> Union(%,"failed")
+--R reductum : % -> %                     sample : () -> %
+--R series : Stream(Coef) -> %            variable : % -> Symbol
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R ?*? : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT))
+--R ?*? : (Fraction(Integer),%) -> % if Coef has ALGEBRA(FRAC(INT))
+--R ?**? : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT))
+--R ?**? : (%,%) -> % if Coef has ALGEBRA(FRAC(INT))
+--R ?**? : (%,Coef) -> % if Coef has FIELD
+--R ?/? : (%,Coef) -> % if Coef has FIELD
+--R D : % -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R D : (%,NonNegativeInteger) -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R D : (%,Symbol) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R D : (%,List(Symbol)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R D : (%,Symbol,NonNegativeInteger) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R acos : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R acosh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R acot : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R acoth : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R acsc : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R acsch : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R approximate : (%,NonNegativeInteger) -> Coef if Coef has **: (Coef,NonNegativeInteger) -> Coef and Coef has coerce: Symbol -> Coef
+--R asec : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R asech : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R asin : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R asinh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R associates? : (%,%) -> Boolean if Coef has INTDOM
+--R atan : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R atanh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R characteristic : () -> NonNegativeInteger
+--R charthRoot : % -> Union(%,"failed") if Coef has CHARNZ
+--R coefficient : (%,NonNegativeInteger) -> Coef
+--R coerce : Coef -> % if Coef has COMRING
+--R coerce : Fraction(Integer) -> % if Coef has ALGEBRA(FRAC(INT))
+--R cos : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cosh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cot : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R coth : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R csc : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R csch : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R differentiate : % -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R differentiate : (%,NonNegativeInteger) -> % if Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R differentiate : (%,Symbol) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R differentiate : (%,List(Symbol)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R differentiate : (%,Symbol,NonNegativeInteger) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has PDRING(SYMBOL) and Coef has *: (NonNegativeInteger,Coef) -> Coef
+--R ?.? : (%,%) -> % if NonNegativeInteger has SGROUP
+--R ?.? : (%,NonNegativeInteger) -> Coef
+--R eval : (%,Coef) -> Stream(Coef) if Coef has **: (Coef,NonNegativeInteger) -> Coef
+--R exp : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R exquo : (%,%) -> Union(%,"failed") if Coef has INTDOM
+--R extend : (%,NonNegativeInteger) -> %
+--R integrate : (%,Symbol) -> % if Coef has ACFS(INT) and Coef has PRIMCAT and Coef has TRANFUN and Coef has ALGEBRA(FRAC(INT)) or Coef has variables: Coef -> List(Symbol) and Coef has integrate: (Coef,Symbol) -> Coef and Coef has ALGEBRA(FRAC(INT))
+--R integrate : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R log : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R monomial : (%,List(SingletonAsOrderedSet),List(NonNegativeInteger)) -> %
+--R monomial : (%,SingletonAsOrderedSet,NonNegativeInteger) -> %
+--R monomial : (Coef,NonNegativeInteger) -> %
+--R multiplyCoefficients : ((Integer -> Coef),%) -> %
+--R multiplyExponents : (%,PositiveInteger) -> %
+--R nthRoot : (%,Integer) -> % if Coef has ALGEBRA(FRAC(INT))
+--R order : (%,NonNegativeInteger) -> NonNegativeInteger
+--R pi : () -> % if Coef has ALGEBRA(FRAC(INT))
+--R polynomial : (%,NonNegativeInteger,NonNegativeInteger) -> Polynomial(Coef)
+--R polynomial : (%,NonNegativeInteger) -> Polynomial(Coef)
+--R sec : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R sech : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R series : Stream(Record(k: NonNegativeInteger,c: Coef)) -> %
+--R sin : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R sinh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R sqrt : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R tan : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R tanh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R terms : % -> Stream(Record(k: NonNegativeInteger,c: Coef))
+--R truncate : (%,NonNegativeInteger,NonNegativeInteger) -> %
+--R truncate : (%,NonNegativeInteger) -> %
+--R unit? : % -> Boolean if Coef has INTDOM
+--R unitCanonical : % -> % if Coef has INTDOM
+--R unitNormal : % -> Record(unit: %,canonical: %,associate: %) if Coef has INTDOM
+--R variables : % -> List(SingletonAsOrderedSet)
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+
+\begin{chunk}{UnivariateTaylorSeriesCategory.help}
+====================================================================
+UnivariateTaylorSeriesCategory examples
+====================================================================
+
+UnivariateTaylorSeriesCategory is the category of Taylor series 
+in one variable.
+
+See Also:
+o )show UnivariateTaylorSeriesCategory
+
+\end{chunk}
+{\bf See:}
+
+\pagefrom{RadicalCategory}{RADCAT}
+\pagefrom{TranscendentalFunctionCategory}{TRANFUN}
+\pagefrom{UnivariatePowerSeriesCategory}{UPSCAT}
+
+{\bf Exports:}\\
+
+\begin{tabular}{llll}
+\cross{UTSCAT}{0} &
+\cross{UTSCAT}{1} &
+\cross{UTSCAT}{acos} &
+\cross{UTSCAT}{acosh} \\
+\cross{UTSCAT}{acot} &
+\cross{UTSCAT}{acoth} &
+\cross{UTSCAT}{acsc} &
+\cross{UTSCAT}{acsch} \\
+\cross{UTSCAT}{approximate} &
+\cross{UTSCAT}{asec} &
+\cross{UTSCAT}{asech} &
+\cross{UTSCAT}{asin} \\
+\cross{UTSCAT}{asinh} &
+\cross{UTSCAT}{associates?} &
+\cross{UTSCAT}{atan} &
+\cross{UTSCAT}{atanh} \\
+\cross{UTSCAT}{center} &
+\cross{UTSCAT}{characteristic} &
+\cross{UTSCAT}{charthRoot} &
 \cross{UTSCAT}{coefficient} \\
 \cross{UTSCAT}{coefficients} &
 \cross{UTSCAT}{coerce} &
@@ -59379,9 +67630,6 @@ UnivariateTaylorSeriesCategory(Coef): Category == Definition where
     -- creates a term c * vv ** k
       k = 0 => c :: OUT
       mon := (k = 1 => vv; vv ** (k :: OUT))
---       if factorials?() and k > 1 then
---         c := factorial(k)$IntegerCombinatoricFunctions * c
---         mon := mon / hconcat(k :: OUT,"!" :: OUT)
       c = 1 => mon
       c = -1 => -mon
       (c :: OUT) * mon
@@ -59485,7 +67733,6 @@ UnivariateTaylorSeriesCategory(Coef): Category == Definition where
             positive? r => 0
             zero? r => error "0**0 undefined"
             error "0 raised to a negative power"
---          not one? frst coefs =>
           not (frst coefs = 1) =>
             error "**: constant coefficient should be 1"
           coefs := concat(0,rst coefs)
@@ -59546,31 +67793,284 @@ UnivariateTaylorSeriesCategory(Coef): Category == Definition where
         acsch x == series acsch(coefficients x)$STNC
 
 \end{chunk}
-\begin{chunk}{UTSCAT.dotabb}
-"UTSCAT"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=UTSCAT"];
-"UTSCAT" -> "UPSCAT"
 
-\end{chunk}
-\begin{chunk}{UTSCAT.dotfull}
-"UnivariateTaylorSeriesCategory(a:Ring)" 
- [color=lightblue,href="bookvol10.2.pdf#nameddest=UTSCAT"];
-"UnivariateTaylorSeriesCategory(a:Ring)" ->
-    "UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)"
+\begin{chunk}{COQ UTSCAT}
+(* category UTSCAT *)
+(*
 
-\end{chunk}
-\begin{chunk}{UTSCAT.dotpic}
-digraph pic {
- fontsize=10;
- bgcolor="#ECEA81";
- node [shape=box, color=white, style=filled];
+    zero? : % -> Boolean
+    zero? x ==
+      empty? (coefs := coefficients x) => true
+      (zero? frst coefs) and (empty? rst coefs) => true
+      false
 
-"UnivariateTaylorSeriesCategory(a:Ring)" [color=lightblue];
-"UnivariateTaylorSeriesCategory(a:Ring)" ->
-    "UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)"
+--% OutputForms
 
-"UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)" 
- [color=seagreen,href="bookvol10.2.pdf#nameddest=UPSCAT"];
+--  We provide defaulr output functions on UTSCAT using the functions
+--  'coefficients', 'center', and 'variable'.
+
+    -- check a global Lisp variable
+    factorials?: () -> Boolean
+    factorials?() == false
+
+    termOutput: (I,Coef,OUT) -> OUT
+    termOutput(k,c,vv) ==
+    -- creates a term c * vv ** k
+      k = 0 => c :: OUT
+      mon := (k = 1 => vv; vv ** (k :: OUT))
+      c = 1 => mon
+      c = -1 => -mon
+      (c :: OUT) * mon
+
+    -- check a global Lisp variable
+    showAll?: () -> Boolean
+    showAll?() == true
+
+    coerce : % -> OutputForm
+    coerce(p:%):OUT ==
+      empty? (uu := coefficients p) => (0$Coef) :: OUT
+      var := variable p; cen := center p
+      vv :=
+        zero? cen => var :: OUT
+        paren(var :: OUT - cen :: OUT)
+      n : NNI ; count : NNI := _$streamCount$Lisp
+      l : L OUT := empty()
+      for n in 0..count while not empty? uu repeat
+        if frst(uu) ^= 0 then
+          l := concat(termOutput(n :: I,frst uu,vv),l)
+        uu := rst uu
+      if showAll?() then
+        for n in (count + 1).. while explicitEntries? uu and _
+               not eq?(uu,rst uu) repeat
+          if frst(uu) ^= 0 then
+            l := concat(termOutput(n :: I,frst uu,vv),l)
+          uu := rst uu
+      l :=
+        explicitlyEmpty? uu => l
+        eq?(uu,rst uu) and frst uu = 0 => l
+        concat(prefix("O" :: OUT,[vv ** (n :: OUT)]),l)
+      empty? l => (0$Coef) :: OUT
+      reduce("+",reverse_! l)
+
+    if Coef has Field then
+
+      ?*? : (%,Coef) -> %
+      (x:%) ** (r:Coef) == series power(r,coefficients x)$STTA
+
+    if Coef has Algebra Fraction Integer then
+      if Coef has CommutativeRing then
+
+        ?**? : (%,%) -> %
+        (x:%) ** (y:%)    == series(coefficients x **$STTF coefficients y)
+
+        ?**? : (%,Fraction(Integer)) -> %
+        (x:%) ** (r:RN)   == series powern(r,coefficients x)$STTA
+
+        exp : % -> %
+        exp x == series exp(coefficients x)$STTF
+
+        log : % -> %
+        log x == series log(coefficients x)$STTF
+
+        sin : % -> %
+        sin x == series sin(coefficients x)$STTF
+
+        cos : % -> %
+        cos x == series cos(coefficients x)$STTF
+
+        tan : % -> %
+        tan x == series tan(coefficients x)$STTF
+
+        cot : % -> %
+        cot x == series cot(coefficients x)$STTF
+
+        sec : % -> %
+        sec x == series sec(coefficients x)$STTF
+
+        csc : % -> %
+        csc x == series csc(coefficients x)$STTF
+
+        asin : % -> %
+        asin x == series asin(coefficients x)$STTF
+
+        acos : % -> %
+        acos x == series acos(coefficients x)$STTF
+
+        atan : % -> %
+        atan x == series atan(coefficients x)$STTF
+
+        acot : % -> %
+        acot x == series acot(coefficients x)$STTF
+
+        asec : % -> %
+        asec x == series asec(coefficients x)$STTF
+
+        acsc : % -> %
+        acsc x == series acsc(coefficients x)$STTF
+
+        sinh : % -> %
+        sinh x == series sinh(coefficients x)$STTF
+
+        cosh : % -> %
+        cosh x == series cosh(coefficients x)$STTF
+
+        tanh : % -> %
+        tanh x == series tanh(coefficients x)$STTF
+
+        coth : % -> %
+        coth x == series coth(coefficients x)$STTF
+
+        sech : % -> %
+        sech x == series sech(coefficients x)$STTF
+
+        csch : % -> %
+        csch x == series csch(coefficients x)$STTF
+
+        asinh : % -> %
+        asinh x == series asinh(coefficients x)$STTF
+
+        acosh : % -> %
+        acosh x == series acosh(coefficients x)$STTF
+
+        atanh : % -> %
+        atanh x == series atanh(coefficients x)$STTF
+
+        acoth : % -> %
+        acoth x == series acoth(coefficients x)$STTF
+
+        asech : % -> %
+        asech x == series asech(coefficients x)$STTF
+
+        acsch : % -> %
+        acsch x == series acsch(coefficients x)$STTF
+
+      else
+
+        ?**? : (%,%) -> %
+        (x:%) ** (y:%) == series(coefficients x **$STNC coefficients y)
+
+        ?**? : (%,Fraction(Integer)) -> %
+        (x:%) ** (r:RN) ==
+          coefs := coefficients x
+          empty? coefs =>
+            positive? r => 0
+            zero? r => error "0**0 undefined"
+            error "0 raised to a negative power"
+          not (frst coefs = 1) =>
+            error "**: constant coefficient should be 1"
+          coefs := concat(0,rst coefs)
+          onePlusX := monom(1,0)$STTA + $STTA monom(1,1)$STTA
+          ratPow := powern(r,onePlusX)$STTA
+          series compose(ratPow,coefs)$STTA
+
+        exp : % -> %
+        exp x == series exp(coefficients x)$STNC
+
+        log : % -> %
+        log x == series log(coefficients x)$STNC
+
+        sin : % -> %
+        sin x == series sin(coefficients x)$STNC
+
+        cos : % -> %
+        cos x == series cos(coefficients x)$STNC
+
+        tan : % -> %
+        tan x == series tan(coefficients x)$STNC
+
+        cot : % -> %
+        cot x == series cot(coefficients x)$STNC
+
+        sec : % -> %
+        sec x == series sec(coefficients x)$STNC
+
+        csc : % -> %
+        csc x == series csc(coefficients x)$STNC
+
+        asin : % -> %
+        asin x == series asin(coefficients x)$STNC
+
+        acos : % -> %
+        acos x == series acos(coefficients x)$STNC
+
+        atan : % -> %
+        atan x == series atan(coefficients x)$STNC
+
+        acot : % -> %
+        acot x == series acot(coefficients x)$STNC
+
+        asec : % -> %
+        asec x == series asec(coefficients x)$STNC
+
+        acsc : % -> %
+        acsc x == series acsc(coefficients x)$STNC
+
+        sinh : % -> %
+        sinh x == series sinh(coefficients x)$STNC
+
+        cosh : % -> %
+        cosh x == series cosh(coefficients x)$STNC
+
+        tanh : % -> %
+        tanh x == series tanh(coefficients x)$STNC
+
+        coth : % -> %
+        coth x == series coth(coefficients x)$STNC
+
+        sech : % -> %
+        sech x == series sech(coefficients x)$STNC
+
+        csch : % -> %
+        csch x == series csch(coefficients x)$STNC
+
+        asinh : % -> %
+        asinh x == series asinh(coefficients x)$STNC
+
+        acosh : % -> %
+        acosh x == series acosh(coefficients x)$STNC
+
+        atanh : % -> %
+        atanh x == series atanh(coefficients x)$STNC
+
+        acoth : % -> %
+        acoth x == series acoth(coefficients x)$STNC
+
+        asech : % -> %
+        asech x == series asech(coefficients x)$STNC
+
+        acsch : % -> %
+        acsch x == series acsch(coefficients x)$STNC
+*)
+
+\end{chunk}
+
+\begin{chunk}{UTSCAT.dotabb}
+"UTSCAT"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=UTSCAT"];
+"UTSCAT" -> "UPSCAT"
+
+\end{chunk}
+
+\begin{chunk}{UTSCAT.dotfull}
+"UnivariateTaylorSeriesCategory(a:Ring)" 
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=UTSCAT"];
+"UnivariateTaylorSeriesCategory(a:Ring)" ->
+    "UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)"
+
+\end{chunk}
+
+\begin{chunk}{UTSCAT.dotpic}
+digraph pic {
+ fontsize=10;
+ bgcolor="#ECEA81";
+ node [shape=box, color=white, style=filled];
+
+"UnivariateTaylorSeriesCategory(a:Ring)" [color=lightblue];
+"UnivariateTaylorSeriesCategory(a:Ring)" ->
+    "UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)"
+
+"UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)" 
+ [color=seagreen,href="bookvol10.2.pdf#nameddest=UPSCAT"];
 "UnivariatePowerSeriesCategory(a:Ring,NonNegativeInteger)" -> 
     "UnivariatePowerSeriesCategory(a:Ring,b:OrderedAbelianMonoid)"
 
@@ -59634,6 +68134,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 16}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{AlgebraicallyClosedField}{ACF}
@@ -59835,6 +68336,7 @@ zerosOf(sup,x)
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{AlgebraicallyClosedField.help}
 ====================================================================
 AlgebraicallyClosedField examples
@@ -60261,9 +68763,7 @@ AlgebraicallyClosedField(): Category == Join(Field,RadicalCategory) with
       nthRoot(- (r::$ / a), d)
 
     binomialRoots(p, y, fn) ==
-     -- p = a * x**n + b
       alpha := assign(x := new(y)$Symbol, fn(p, x))
---      one?(n := degree p) =>  [ alpha ]
       ((n := degree p) = 1) =>  [ alpha ]
       cyclo := cyclotomic(n,monomial(1,1)$SUP)_
                     $NumberTheoreticPolynomialFunctions(SUP)
@@ -60297,6 +68797,106 @@ AlgebraicallyClosedField(): Category == Join(Field,RadicalCategory) with
       reverse_! ans
 
 \end{chunk}
+
+\begin{chunk}{COQ ACF}
+(* category ACF *)
+(*
+
+    SUP ==> SparseUnivariatePolynomial $
+
+    zeroOf : Polynomial(%) -> %
+    zeroOf(p:SUP) == assign(x := new(), zeroOf(p, x))
+
+    rootOf : Polynomial(%) -> %
+    rootOf(p:SUP) == assign(x := new(), rootOf(p, x))
+
+    zerosOf : Polynomial(%) -> List(%)
+    zerosOf(p:SUP) == zerosOf(p, new())
+
+    rootsOf : SparseUnivariatePolynomial(%) -> List(%)
+    rootsOf(p:SUP) == rootsOf(p, new())
+
+    rootsOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%)
+    rootsOf(p:SUP, y:Symbol) == allroots(p, y, rootOf)
+
+    zerosOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%)
+    zerosOf(p:SUP, y:Symbol) == allroots(p, y, zeroOf)
+
+    assign  : (Symbol, $) -> $
+    assign(x, f) == (assignSymbol(x, f, $)$Lisp; f)
+
+    zeroOf : Polynomial(%) -> %
+    zeroOf(p:Polynomial $) ==
+      empty?(l := variables p) => error "zeroOf: constant polynomial"
+      zeroOf(univariate p, first l)
+
+    rootOf : Polynomial(%) -> %
+    rootOf(p:Polynomial $) ==
+      empty?(l := variables p) => error "rootOf: constant polynomial"
+      rootOf(univariate p, first l)
+
+    zerosOf : Polynomial(%) -> List(%)
+    zerosOf(p:Polynomial $) ==
+      empty?(l := variables p) => error "zerosOf: constant polynomial"
+      zerosOf(univariate p, first l)
+
+    rootsOf : Polynomial(%) -> List(%)
+    rootsOf(p:Polynomial $) ==
+      empty?(l := variables p) => error "rootsOf: constant polynomial"
+      rootsOf(univariate p, first l)
+
+    zeroOf : (SparseUnivariatePolynomial(%),Symbol) -> %
+    zeroOf(p:SUP, y:Symbol) ==
+      zero?(d := degree p) => error "zeroOf: constant polynomial"
+      zero? coefficient(p, 0) => 0
+      a := leadingCoefficient p
+      d = 2 =>
+        b := coefficient(p, 1)
+        (sqrt(b**2 - 4 * a * coefficient(p, 0)) - b) / (2 * a)
+      (r := retractIfCan(reductum p)@Union($,"failed")) case "failed" =>
+        rootOf(p, y)
+      nthRoot(- (r::$ / a), d)
+
+    binomialRoots: (SUP, Symbol, (SUP, Symbol) -> $) -> List $
+    binomialRoots(p, y, fn) ==
+      alpha := assign(x := new(y)$Symbol, fn(p, x))
+      ((n := degree p) = 1) =>  [ alpha ]
+      cyclo := cyclotomic(n,monomial(1,1)$SUP)_
+                    $NumberTheoreticPolynomialFunctions(SUP)
+      beta := assign(x := new(y)$Symbol, fn(cyclo, x))
+      [alpha*beta**i for i in 0..(n-1)::NonNegativeInteger]
+
+    import PolynomialDecomposition(SUP,$)
+
+    allroots: (SUP, Symbol, (SUP, Symbol) -> $) -> List $
+    allroots(p, y, fn) ==
+      zero? p => error "allroots: polynomial must be nonzero"
+      zero? coefficient(p,0) =>
+         concat(0, allroots(p quo monomial(1,1), y, fn))
+      zero?(p1:=reductum p) => empty()
+      zero? reductum p1 => binomialRoots(p, y, fn)
+      decompList := decompose(p)
+      # decompList > 1 =>
+          h := last decompList
+          g := leftFactor(p,h) :: SUP
+          groots := allroots(g, y, fn)
+          "append"/[allroots(h-r::SUP, y, fn) for r in groots]
+      ans := nil()$List($)
+      while not ground? p repeat
+        alpha := assign(x := new(y)$Symbol, fn(p, x))
+        q     := monomial(1, 1)$SUP - alpha::SUP
+        if not zero?(p alpha) then
+          p   := p quo q
+          ans := concat(alpha, ans)
+        else while zero?(p alpha) repeat
+          p   := (p exquo q)::SUP
+          ans := concat(alpha, ans)
+      reverse_! ans
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ACF.dotabb}
 "ACF"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ACF"];
@@ -60304,6 +68904,7 @@ AlgebraicallyClosedField(): Category == Join(Field,RadicalCategory) with
 "ACF" -> "RADCAT"
 
 \end{chunk}
+
 \begin{chunk}{ACF.dotfull}
 "AlgebraicallyClosedField()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ACF"];
@@ -60311,6 +68912,7 @@ AlgebraicallyClosedField(): Category == Join(Field,RadicalCategory) with
 "AlgebraicallyClosedField()" -> "RadicalCategory()"
 
 \end{chunk}
+
 \begin{chunk}{ACF.dotpic}
 digraph pic {
  fontsize=10;
@@ -60345,6 +68947,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{DifferentialPolynomialCategory}{DPOLCAT}
 \pagepic{ps/v102differentialpolynomialcategory.ps}{DPOLCAT}{0.35}
@@ -60508,6 +69111,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{DifferentialPolynomialCategory.help}
 ====================================================================
 DifferentialPolynomialCategory examples
@@ -61158,6 +69762,151 @@ DifferentialPolynomialCategory(R:Ring,S:OrderedSet,
               [rhs e for e in l]$List($))
 
 \end{chunk}
+
+\begin{chunk}{COQ DPOLCAT}
+(* category DPOLCAT *)
+(*
+    p:$
+    s:S
+
+    makeVariable : % -> (NonNegativeInteger -> %)
+    makeVariable s == n +-> makeVariable(s,n)::$
+
+    if R has IntegralDomain then
+
+      differentiate : (%,(R -> R)) -> %
+      differentiate(p:$, d:R -> R) ==
+        ans:$ := 0
+        l := variables p
+        while (u:=retractIfCan(p)@Union(R, "failed")) case "failed" repeat
+          t := leadingMonomial p
+          lc := leadingCoefficient t
+          ans := ans + d(lc)::$ * (t exquo lc)::$
+              + +/[differentiate(t, v) * (differentiate v)::$ for v in l]
+          p := reductum p
+        ans + d(u::R)::$
+
+    order : % -> NonNegativeInteger
+    order (p:$):NonNegativeInteger ==
+      ground? p => 0
+      "max"/[order v for v in variables p]
+
+    order : (%,S) -> NonNegativeInteger
+    order (p:$,s:S):NonNegativeInteger ==
+      ground? p => 0
+      empty? (vv:= [order v for v in variables p | (variable v) = s ]) =>0
+      "max"/vv
+
+    degree : (%,S) -> NonNegativeInteger
+    degree (p, s) ==
+      d:NonNegativeInteger:=0
+      for lp in monomials p repeat
+        lv:= [v for v in variables lp | (variable v) = s ]
+        if not empty? lv then d:= max(d, +/degree(lp, lv))
+      d
+
+    weights : % -> List(NonNegativeInteger)
+    weights p ==
+      ws:List NonNegativeInteger := nil
+      empty? (mp:=monomials p) => ws
+      for lp in mp repeat
+        lv:= variables lp
+        if not empty? lv then
+          dv:= degree(lp, lv)
+          w:=+/[(weight v) * d _
+                 for v in lv for d in dv]$(List NonNegativeInteger)
+          ws:= concat(ws, w)
+      ws
+
+    weight : % -> NonNegativeInteger
+    weight p ==
+      empty? (ws:=weights p) => 0
+      "max"/ws
+
+    weights : (%,S) -> List(NonNegativeInteger)
+    weights (p, s) ==
+      ws:List NonNegativeInteger := nil
+      empty?(mp:=monomials p) => ws
+      for lp in mp repeat
+        lv:= [v for v in variables lp | (variable v) = s ]
+        if not empty? lv then
+          dv:= degree(lp, lv)
+          w:=+/[(weight v) * d _
+               for v in lv for d in dv]$(List NonNegativeInteger)
+          ws:= concat(ws, w)
+      ws
+
+    weight : (%,S) -> NonNegativeInteger
+    weight (p,s)  ==
+      empty? (ws:=weights(p,s)) => 0
+      "max"/ws
+
+    isobaric? : % -> Boolean
+    isobaric? p == (# removeDuplicates weights p) = 1
+
+    leader : % -> V
+    leader p ==             -- depends on the ranking
+      vl:= variables p
+      -- it's not enough just to look at leadingMonomial p
+      -- the term-ordering need not respect the ranking
+      empty? vl => error "leader is not defined "
+      "max"/vl
+
+    initial : % -> %
+    initial p == leadingCoefficient univariate(p,leader p)
+
+    separant : % -> %
+    separant p == differentiate(p, leader p)
+
+    coerce : S -> %
+    coerce(s:S):$   == s::V::$
+
+    retractIfCan : % -> Union(S,"failed")
+    retractIfCan(p:$):Union(S, "failed") ==
+      (v := retractIfCan(p)@Union(V,"failed")) case "failed" => "failed"
+      retractIfCan(v::V)
+
+    differentialVariables : % -> List(S)
+    differentialVariables p ==
+      removeDuplicates [variable v for v in variables p]
+
+    if R has DifferentialRing then
+
+      makeVariable : % -> (NonNegativeInteger -> %)
+      makeVariable p == n +-> differentiate(p, n)
+
+      eval : (%,List(S),List(R)) -> %
+      eval(p:$, sl:List S, rl:List R) ==
+        ordp:= order p
+        vl  := concat [[makeVariable(s,j)$V for j in  0..ordp]
+                                for s in sl]$List(List V)
+        rrl:=nil$List(R)
+        for r in rl repeat
+          t:= r
+          rrl:= concat(rrl,
+                concat(r, [t := differentiate t for i in 1..ordp]))
+        eval(p, vl, rrl)
+
+      eval : (%,List(S),List(%)) -> %
+      eval(p:$, sl:List S, rl:List $) ==
+        ordp:= order p
+        vl  := concat [[makeVariable(s,j)$V for j in  0..ordp]
+                                for s in sl]$List(List V)
+        rrl:=nil$List($)
+        for r in rl repeat
+          t:=r
+          rrl:=concat(rrl,
+               concat(r, [t:=differentiate t for i in 1..ordp]))
+        eval(p, vl, rrl)
+
+      eval : (%,List(Equation(%))) -> %
+      eval(p:$, l:List Equation $) ==
+        eval(p, [retract(lhs e)@S for e in l]$List(S),
+              [rhs e for e in l]$List($))
+*)
+
+\end{chunk}
+
 \begin{chunk}{DPOLCAT.dotabb}
 "DPOLCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DPOLCAT"];
@@ -61166,6 +69915,7 @@ DifferentialPolynomialCategory(R:Ring,S:OrderedSet,
 "DPOLCAT" -> "RETRACT"
 
 \end{chunk}
+
 \begin{chunk}{DPOLCAT.dotfull}
 "DifferentialPolynomialCategory(a:Ring,b:OrderedSet,c:DifferentialVariableCategory(b),d:OrderedAbelianMonoidSup)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=DPOLCAT"];
@@ -61177,6 +69927,7 @@ DifferentialPolynomialCategory(R:Ring,S:OrderedSet,
  -> "RetractableTo(OrderedSet)"
 
 \end{chunk}
+
 \begin{chunk}{DPOLCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -61241,6 +69992,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FieldOfPrimeCharacteristic}{FPC}
 \pagepic{ps/v102fieldofprimecharacteristic.ps}{FPC}{1.00}
@@ -61308,6 +70060,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FieldOfPrimeCharacteristic.help}
 ====================================================================
 FieldOfPrimeCharacteristic examples
@@ -61515,6 +70268,17 @@ FieldOfPrimeCharacteristic:Category == _
    primeFrobenius(a,s) == a ** (characteristic()**s)
 
 \end{chunk}
+
+\begin{chunk}{COQ FPC}
+(* category FPC *)
+(*
+   primeFrobenius(a) == a ** characteristic()
+   primeFrobenius(a,s) == a ** (characteristic()**s)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FPC.dotabb}
 "FPC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FPC"];
@@ -61522,12 +70286,14 @@ FieldOfPrimeCharacteristic:Category == _
 "FPC" -> "FIELD"
 
 \end{chunk}
+
 \begin{chunk}{FPC.dotfull}
 "FieldOfPrimeCharacteristic()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FPC"];
 "FieldOfPrimeCharacteristic()" -> "CharacteristicNonZero()"
 
 \end{chunk}
+
 \begin{chunk}{FPC.dotpic}
 digraph pic {
  fontsize=10;
@@ -61558,6 +70324,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FiniteRankAlgebra}{FINRALG}
 \pagepic{ps/v102finiterankalgebra.ps}{FINRALG}{0.50}
@@ -61610,6 +70377,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FiniteRankAlgebra.help}
 ====================================================================
 FiniteRankAlgebra examples
@@ -61810,6 +70578,41 @@ FiniteRankAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R):
        [parts coordinates(x*b(i+m),b) for i in 1..rank()]$List(List R)
 
 \end{chunk}
+
+\begin{chunk}{COQ FINRALG}
+(* category FINRALG *)
+(*
+
+    discriminant : Vector(%) -> R
+    discriminant v == determinant traceMatrix v
+
+    coordinates : (Vector(%),Vector(%)) -> Matrix(R)
+    coordinates(v:Vector %, b:Vector %) ==
+      m := new(#v, #b, 0)$Matrix(R)
+      for i in minIndex v .. maxIndex v for j in minRowIndex m .. repeat
+        setRow_!(m, j, coordinates(qelt(v, i), b))
+      m
+
+    represents : (Vector(R),Vector(%)) -> %
+    represents(v, b) ==
+      m := minIndex v - 1
+      _+/[v(i+m) * b(i+m) for i in 1..rank()]
+
+    traceMatrix : Vector(%) -> Matrix(R)
+    traceMatrix v ==
+      matrix [[trace(v.i*v.j) for j in minIndex v..maxIndex v]$List(R)
+               for i in minIndex v .. maxIndex v]$List(List R)
+
+    regularRepresentation : (%,Vector(%)) -> Matrix(R)
+    regularRepresentation(x, b) ==
+      m := minIndex b - 1
+      matrix
+       [parts coordinates(x*b(i+m),b) for i in 1..rank()]$List(List R)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FINRALG.dotabb}
 "FINRALG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FINRALG"];
@@ -61819,6 +70622,7 @@ FiniteRankAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R):
 "FINRALG" -> "CHARZ"
 
 \end{chunk}
+
 \begin{chunk}{FINRALG.dotfull}
 "FiniteRankAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FINRALG"];
@@ -61832,6 +70636,7 @@ FiniteRankAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R):
     "CharacteristicZero()"
 
 \end{chunk}
+
 \begin{chunk}{FINRALG.dotpic}
 digraph pic {
  fontsize=10;
@@ -61872,6 +70677,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FunctionSpace}{FS}
 \pagepic{ps/v102functionspace.ps}{FS}{0.65}
@@ -62052,6 +70858,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FunctionSpace.help}
 ====================================================================
 FunctionSpace examples
@@ -62920,7 +71727,6 @@ FunctionSpace(R:OrderedSet): Category == Definition where
         [kernel(op, z), g, l.n]
 
       opderiv(op, n) ==
---        one? n =>
         (n = 1) =>
           g := symsub(gendiff, n)::%
           [x +-> kernel(opdiff,[kernel(op, g), g, first x])]
@@ -63027,7 +71833,6 @@ FunctionSpace(R:OrderedSet): Category == Definition where
 
       if R has RetractableTo Z then
           smpIsMult p ==
---          (u := mainVariable p) case K and one? degree(q:=univariate(p,u::K))
             (u := mainVariable p) case K and (degree(q:=univariate(p,u::K))=1)
               and zero?(leadingCoefficient reductum q)
                 and ((r:=retractIfCan(leadingCoefficient q)@Union(R,"failed"))
@@ -63160,7 +71965,6 @@ FunctionSpace(R:OrderedSet): Category == Definition where
       retract(x:%):R == (retract(numer x)@R exquo retract(denom x)@R)::R
 
       coerce(x:%):OutputForm ==
---        one?(denom x) => smp2O numer x
         ((denom x) = 1) => smp2O numer x
         smp2O(numer x) / smp2O(denom x)
 
@@ -63233,1512 +72037,1069 @@ FunctionSpace(R:OrderedSet): Category == Definition where
           convert(numer x) / convert(denom x)
 
 \end{chunk}
-\begin{chunk}{FS.dotabb}
-"FS"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=FS"];
-"FS" -> "ES"
-"FS" -> "FPATMAB"
-"FS" -> "FRETRCT"
-"FS" -> "PATAB"
-"FS" -> "RETRACT"
-"FS" -> "KONVERT"
-"FS" -> "MONOID"
-"FS" -> "GROUP"
-"FS" -> "ABELMON"
-"FS" -> "ABELGRP"
-"FS" -> "PDRING"
-"FS" -> "FLINEXP"
-"FS" -> "CHARNZ"
-"FS" -> "INTDOM"
-"FS" -> "FIELD"
 
-\end{chunk}
-\begin{chunk}{FS.dotfull}
-"FunctionSpace(a:OrderedSet)"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=FS"];
-"FunctionSpace(a:OrderedSet)" -> "ExpressionSpace()"
-"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Symbol)"
-"FunctionSpace(a:OrderedSet)" -> "Patternable(OrderedSet)"
-"FunctionSpace(a:OrderedSet)" -> "FullyPatternMatchable(OrderedSet)"
-"FunctionSpace(a:OrderedSet)" -> "FullyRetractableTo(OrderedSet)"
-"FunctionSpace(a:OrderedSet)" -> "ConvertibleTo(InputForm)"
-"FunctionSpace(a:OrderedSet)" -> "Monoid()"
-"FunctionSpace(a:OrderedSet)" -> "Group()"
-"FunctionSpace(a:OrderedSet)" -> "AbelianMonoid()"
-"FunctionSpace(a:OrderedSet)" -> "AbelianGroup()"
-"FunctionSpace(a:OrderedSet)" -> "PartialDifferentialRing(Symbol)"
-"FunctionSpace(a:OrderedSet)" -> "FullyLinearlyExplicitRingOver(OrderedSet)"
-"FunctionSpace(a:OrderedSet)" -> "CharacteristicNonZero()"
-"FunctionSpace(a:OrderedSet)" -> "IntegralDomain()"
-"FunctionSpace(a:OrderedSet)" -> "Field()"
-"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Integer)"
-"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Fraction(Integer))"
+\begin{chunk}{COQ FS}
+(* category FS *)
+(*
+    import BasicOperatorFunctions1(%)
 
-\end{chunk}
-\begin{chunk}{FS.dotpic}
-digraph pic {
- fontsize=10;
- bgcolor="#ECEA81";
- node [shape=box, color=white, style=filled];
+    -- these are needed in Ring only, but need to be declared here
+    -- because of compiler bug: if they are declared inside the Ring
+    -- case, then they are not visible inside the IntegralDomain case.
 
-"FunctionSpace(a:OrderedSet)" [color=lightblue];
-"FunctionSpace(a:OrderedSet)" -> "ES..."
-"FunctionSpace(a:OrderedSet)" -> "RETRACT..."
-"FunctionSpace(a:OrderedSet)" -> "PATAB..."
-"FunctionSpace(a:OrderedSet)" -> "FPATMAB..."
-"FunctionSpace(a:OrderedSet)" -> "FRETRCT..."
-"FunctionSpace(a:OrderedSet)" -> "KONVERT..."
-"FunctionSpace(a:OrderedSet)" -> "MONOID..."
-"FunctionSpace(a:OrderedSet)" -> "GROUP..."
-"FunctionSpace(a:OrderedSet)" -> "ABELMON..."
-"FunctionSpace(a:OrderedSet)" -> "ABELGRP..."
-"FunctionSpace(a:OrderedSet)" -> "PDRING..."
-"FunctionSpace(a:OrderedSet)" -> "FLINEXP..."
-"FunctionSpace(a:OrderedSet)" -> "CHARNZ..."
-"FunctionSpace(a:OrderedSet)" -> "INTDOM..."
-"FunctionSpace(a:OrderedSet)" -> "FIELD..."
-"FunctionSpace(a:OrderedSet)" -> "RETRACT..."
+    opdiff := operator("%diff"::SY)$CommonOperators()
 
-"ES..." [color=lightblue];
-"EVALABLE..." [color=lightblue];
-"FRETRCT..." [color=lightblue];
-"FPATMAB..." [color=lightblue];
-"IEVALAB..." [color=lightblue];
-"ORDSET..." [color=lightblue];
-"PATAB..." [color=lightblue];
-"RETRACT..." [color=lightblue];
-"KONVERT..." [color=lightblue];
-"MONOID..." [color=lightblue];
-"GROUP..." [color=lightblue];
-"ABELMON..." [color=lightblue];
-"ABELGRP..." [color=lightblue];
-"PDRING..." [color=lightblue];
-"FLINEXP..." [color=lightblue];
-"CHARNZ..." [color=lightblue];
-"INTDOM..." [color=lightblue];
-"FIELD..." [color=lightblue];
-"RETRACT..." [color=lightblue];
-}
+    opquote := operator("applyQuote"::SY)$CommonOperators
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\pagehead{InfinitlyClosePointCategory}{INFCLCT}
-\pagepic{ps/v102infinitlyclosepointcategory.eps}{INFCLCT}{0.50}
+    ground? : % -> Boolean
+    ground? x == retractIfCan(x)@Union(R,"failed") case R
 
-\begin{chunk}{InfinitlyClosePointCategory.input}
-)set break resume
-)sys rm -f InfinitlyClosePointCategory.output
-)spool InfinitlyClosePointCategory.output
-)set message test on
-)set message auto off
-)clear all
+    ground : % -> R
+    ground  x == retract x
 
---S 1 of 1
-)show InfinitlyClosePointCategory
---R 
---I InfinitlyClosePointCategory(K: Field,
---I symb: List Symbol,
---I PolyRing: PolynomialCategory(t#1,t#4,OrderedVariableList t#2),
---I E: DirectProductCategory(# t#2,NonNegativeInteger),
---I ProjPt: ProjectiveSpaceCategory t#1,
---I PCS: LocalPowerSeriesCategory t#1,
---I Plc: PlacesCategory(t#1,t#6),
---I DIVISOR: DivisorCategory t#7,
---I BLMET: BlowUpMethodCategory) is a category constructor
---I Abbreviation for InfinitlyClosePointCategory is INFCLCT 
---I This constructor is exposed in this frame.
---I Issue )edit bookvol10.2.pamphlet to see algebra source code for INFCLCT 
---I
---I------------------------------- Operations --------------------------------
---I ?=? : (%,%) -> Boolean                actualExtensionV : % -> K
---I chartV : % -> BLMET                   coerce : % -> OutputForm
---I create : (ProjPt,PolyRing) -> %       degree : % -> PositiveInteger
---I excpDivV : % -> DIVISOR               hash : % -> SingleInteger
---I latex : % -> String                   localParamV : % -> List PCS
---I localPointV : % -> AffinePlane K      multV : % -> NonNegativeInteger
---I pointV : % -> ProjPt                  setchart! : (%,BLMET) -> BLMET
---I setpoint! : (%,ProjPt) -> ProjPt      symbNameV : % -> Symbol
---I ?~=? : (%,%) -> Boolean              
---I create : (ProjPt,
---I  DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),
---I  AffinePlane K,
---I  NonNegativeInteger,
---I  BLMET,
---I  NonNegativeInteger,
---I  DIVISOR,
---I  K,
---I  Symbol) -> %
---I curveV : % -> 
---I  DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
---I setcurve! : 
---I  (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> 
---I  DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
---I setexcpDiv! : (%,DIVISOR) -> DIVISOR
---I setlocalParam! : (%,List PCS) -> List PCS
---I setlocalPoint! : (%,AffinePlane K) -> AffinePlane K
---I setmult! : (%,NonNegativeInteger) -> NonNegativeInteger
---I setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger
---I setsymbName! : (%,Symbol) -> Symbol
---I subMultV : % -> NonNegativeInteger
---I
---E 1
+    coerce : Symbol -> %
+    coerce(x:SY):% == kernel(x)@K :: %
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{InfinitlyClosePointCategory.help}
-====================================================================
-InfinitlyClosePointCategory examples
-====================================================================
+    retract : % -> Symbol
+    retract(x:%):SY == symbolIfCan(retract(x)@K)::SY
 
-This category is part of the PAFF package
+    applyQuote : (Symbol,%) -> %
+    applyQuote(s:SY, x:%) == applyQuote(s, [x])
 
-See Also:
-o )show InfinitlyClosePointCategory
+    applyQuote : (Symbol,%,%) -> %
+    applyQuote(s, x, y) == applyQuote(s, [x, y])
 
-\end{chunk}
+    applyQuote : (Symbol,%,%,%) -> %
+    applyQuote(s, x, y, z) == applyQuote(s, [x, y, z])
 
-\pagefrom{SetCategoryWithDegree}{SETCATD}
+    applyQuote : (Symbol,%,%,%,%) -> %
+    applyQuote(s, x, y, z, t)  == applyQuote(s, [x, y, z, t])
 
-{\bf Exports:}\\
-\begin{tabular}{llll}
-\cross{INFCLCT}{?=?} &
-\cross{INFCLCT}{?\~{}=?} &
-\cross{INFCLCT}{actualExtensionV} &
-\cross{INFCLCT}{chartV} \\
-\cross{INFCLCT}{coerce} &
-\cross{INFCLCT}{create} &
-\cross{INFCLCT}{curveV} &
-\cross{INFCLCT}{degree} \\
-\cross{INFCLCT}{excpDivV} &
-\cross{INFCLCT}{hash} &
-\cross{INFCLCT}{latex} &
-\cross{INFCLCT}{localParamV} \\
-\cross{INFCLCT}{localPointV} &
-\cross{INFCLCT}{multV} &
-\cross{INFCLCT}{pointV} &
-\cross{INFCLCT}{setchart!} \\
-\cross{INFCLCT}{setcurve!} &
-\cross{INFCLCT}{setexcpDiv!} &
-\cross{INFCLCT}{setlocalParam!} &
-\cross{INFCLCT}{setlocalPoint!} \\
-\cross{INFCLCT}{setmult!} &
-\cross{INFCLCT}{setpoint!} &
-\cross{INFCLCT}{setsubmult!} &
-\cross{INFCLCT}{setsymbName!} \\
-\cross{INFCLCT}{subMultV} &
-\cross{INFCLCT}{symbNameV} &&
-\end{tabular} 
+    applyQuote : (Symbol,List(%)) -> %
+    applyQuote(s:SY, l:List %) == opquote concat(s::%, l)
 
-These are directly exported but not implemented:
-\begin{verbatim}
- actualExtensionV : % -> K
- chartV : % -> BLMET                  
- create :
-  (ProjPt,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),
-   AffinePlane K,NonNegativeInteger,BLMET,NonNegativeInteger,DIVISOR,K,Symbol)
-     -> %
- create : (ProjPt,PolyRing) -> %      
- curveV : % -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
- excpDivV : % -> DIVISOR              
- localParamV : % -> List PCS
- localPointV : % -> AffinePlane K     
- multV : % -> NonNegativeInteger
- pointV : % -> ProjPt                 
- setchart! : (%,BLMET) -> BLMET
- setcurve! :
-   (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> 
-     DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
- setexcpDiv! : (%,DIVISOR) -> DIVISOR
- setlocalParam! : (%,List PCS) -> List PCS
- setlocalPoint! : (%,AffinePlane K) -> AffinePlane K
- setmult! : (%,NonNegativeInteger) -> NonNegativeInteger
- setpoint! : (%,ProjPt) -> ProjPt     
- setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger
- setsymbName! : (%,Symbol) -> Symbol
- subMultV : % -> NonNegativeInteger
- symbNameV : % -> Symbol
-\end{verbatim}
+    belong? : BasicOperator -> Boolean
+    belong? op == op = opdiff or op = opquote
 
-These exports come from \refto{SetCategoryWithDegree}:
-\begin{verbatim}
- ?=? : (%,%) -> Boolean               
- ?~=? : (%,%) -> Boolean
- coerce : % -> OutputForm
- degree : % -> PositiveInteger        
- hash : % -> SingleInteger
- latex : % -> String                  
-\end{verbatim}
+    subs : (% -> %, K) -> %
+    subs(fn, k) == kernel(operator k,[fn x for x in argument k]$List(%))
 
-\begin{chunk}{category INFCLCT InfinitlyClosePointCategory}
-)abbrev category INFCLCT InfinitlyClosePointCategory
-++ Authors: Gaetan Hache
-++ Date Created: may 1997 
-++ Date Last Updated: April 2010, by Tim Daly
-++ Description: 
-++ This category is part of the PAFF package
-InfinitlyClosePointCategory(_
-     K        :Field,_
-     symb     :List(Symbol),_
-     PolyRing :PolynomialCategory(K,E,OrderedVariableList(symb)),_
-     E        :DirectProductCategory(#symb,NonNegativeInteger),_
-     ProjPt   :ProjectiveSpaceCategory(K),_
-     PCS      :LocalPowerSeriesCategory(K),_
-     Plc      :PlacesCategory(K,PCS),_
-     DIVISOR  :DivisorCategory(Plc),_
-     BLMET    :BlowUpMethodCategory_
-       ):Category == Exports where
+    operator : BasicOperator -> BasicOperator
+    operator op ==
+      is?(op, "%diff"::SY) => opdiff
+      is?(op, "%quote"::SY) => opquote
+      error "Unknown operator"
 
- bls      ==> ['X,'Y]
- BlUpRing ==> DistributedMultivariatePolynomial(bls , K)
- AFP      ==> AffinePlane(K)
+    if R has ConvertibleTo InputForm then
 
- Exports ==> SetCategoryWithDegree with
+      INP==>InputForm
 
-    create:  (ProjPt ,  BlUpRing, AFP , NonNegativeInteger,BLMET, _
-              NonNegativeInteger,  DIVISOR,K,Symbol) -> %  
-      ++ create an infinitly close point
+      import MakeUnaryCompiledFunction(%, %, %)
 
-    create:  (ProjPt,PolyRing) -> %
-      
-    setpoint_!:  (%,ProjPt) -> ProjPt
+      differentiand: List % -> %
+      differentiand l == eval(first l, retract(second l)@K, third l)
 
-    setcurve_!:  (%,BlUpRing) -> BlUpRing
+      pint  : List INP-> INP
+      pint l  == convert concat(convert("D"::SY)@INP, l)
 
-    setlocalPoint_!:   (%,AFP) -> AFP
- 
-    setsubmult_! : (%, NonNegativeInteger) -> NonNegativeInteger
+      indiff: List % -> INP
+      indiff l ==
+         r2:= convert([convert("::"::SY)@INP,_
+                       convert(third l)@INP,_
+                       convert("Symbol"::SY)@INP]@List INP)@INP
+         pint [convert(differentiand l)@INP, r2] 
 
-    setmult_!:    (%,NonNegativeInteger) -> NonNegativeInteger
- 
-    setchart_!:   (%,BLMET) -> BLMET -- CHH
+      eval(f:%, s:SY)            == eval(f, [s])
 
-    setexcpDiv_!: (%,DIVISOR) -> DIVISOR
+      eval(f:%, s:OP, g:%, x:SY) == eval(f, [s], [g], x)
 
-    setlocalParam_!: (%,List PCS) -> List(PCS)
+      eval(f:%, ls:List OP, lg:List %, x:SY) ==
+        eval(f, ls, [compiledFunction(g, x) for g in lg])
 
-    setsymbName_!: (%,Symbol) -> Symbol
- 
-    subMultV: % -> NonNegativeInteger
+      setProperty(opdiff,SPECIALINPUT,_
+                   indiff@(List % -> InputForm) pretend None)
 
-    localParamV: % -> List PCS
+    variables : % -> List(Symbol)
+    variables x ==
+      l := empty()$List(SY)
+      for k in tower x repeat
+        if ((s := symbolIfCan k) case SY) then l := concat(s::SY, l)
+      reverse_! l
 
-    symbNameV: % -> Symbol
+    retractIfCan : % -> Union(Symbol,"failed")
+    retractIfCan(x:%):Union(SY, "failed") ==
+      (k := retractIfCan(x)@Union(K,"failed")) case "failed" => "failed"
+      symbolIfCan(k::K)
 
-    pointV:  % -> ProjPt
-      ++ pointV returns the infinitly close point.
+    if R has Ring then
 
-    curveV:  % -> BlUpRing
-      ++ curveV(p) returns the defining polynomial of the strict transform 
-      ++ on which lies the corresponding infinitly close point.
+      import UserDefinedPartialOrdering(SY)
 
-    localPointV: % -> AFP
-      ++ localPointV returns the coordinates of the local infinitly 
-      ++ close point
+-- cannot use new()$Symbol because of possible re-instantiation
+      gendiff := "%%0"::SY
 
-    multV:       % -> NonNegativeInteger
-      ++ multV returns the multiplicity of the infinitly close point.
+      characteristic : () -> NonNegativeInteger
+      characteristic() == characteristic()$R
 
-    chartV:      % -> BLMET -- CHH
-      ++ chartV is the chart of the infinitly close point. The first integer 
-      ++ correspond to variable defining the exceptional line, the last one 
-      ++ the affine  neighboorhood and the second one is the 
-      ++ remaining integer. For example [1,2,3] means that
-      ++ Z=1, X=X and Y=XY. [2,3,1] means that X=1, Y=Y and Z=YZ.     
+      coerce : Kernel(%) -> %
+      coerce(k:K):% == k::MP::%
 
-    excpDivV:    % -> DIVISOR
-      ++ excpDivV returns the exceptional divisor of the infinitly close point.
+      symsub : (SY, Z) -> SY
+      symsub(sy, i) == concat(string sy, convert(i)@String)::SY
 
-    actualExtensionV: % -> K
+      numerator : % -> %
+      numerator x == numer(x)::%
 
-\end{chunk}
-\begin{chunk}{INFCLCT.dotabb}
-"INFCLCT" [color=lightblue,href="bookvol10.2.pdf#nameddest=INFCLCT"];
-"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
-"INFCLCT" -> "ALIST"
+      eval : (%,Symbol,NonNegativeInteger,(% -> %)) -> %
+      eval(x:%, s:SY, n:N, f:% -> %) == 
+        eval(x,[s],[n],[(y:List %):% +-> f(first(y))])
 
-\end{chunk}
-\begin{chunk}{INFCLCT.dotfull}
-"InfinitlyClosePointCategory"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=INFCLCT"];
-"InfinitlyClosePointCategory" -> "AssocationList(SetCategory,SetCategory)"
+      eval : (%,Symbol,NonNegativeInteger,(List(%) -> %)) -> %
+      eval(x:%, s:SY, n:N, f:List % -> %) == eval(x, [s], [n], [f])
 
-\end{chunk}
-\begin{chunk}{INFCLCT.dotpic}
-digraph pic {
- fontsize=10;
- bgcolor="#ECEA81";
- node [shape=box, color=white, style=filled];
+      eval : (%,List(Symbol),List((List(%) -> %))) -> %
+      eval(x:%, l:List SY, f:List(List % -> %)) == eval(x, l, new(#l, 1), f)
 
-"InfinitlyClosePointCategory" [color=lightblue];
-"InfinitlyClosePointCategory" -> "AssocationList(SetCategory,SetCategory)"
+      elt : (BasicOperator,List(%)) -> %
+      elt(op:OP, args:List %) ==
+        unary? op and ((od? := has?(op, ODD)) or has?(op, EVEN)) and
+          leadingCoefficient(numer first args) < 0 =>
+            x := op(- first args)
+            od? => -x
+            x
+        elt(op, args)$ExpressionSpace_&(%)
 
-"AssocationList(SetCategory,SetCategory)" -> "AssocationList()"
+      eval : (%,List(Symbol),List(NonNegativeInteger),List((% -> %))) -> %
+      eval(x:%, s:List SY, n:List N, l:List(% -> %)) ==
+        eval(x, s, n, [y+-> f(first(y)) for f in l]$List(List % -> %))
 
-"AssocationList()" [color=lightblue];
+      -- op(arg)**m ==> func(arg)**(m quo n) * op(arg)**(m rem n)
+      smprep : (List SY, List N, List(List % -> %), MP) -> %
+      smprep(lop, lexp, lfunc, p) ==
+        (v := mainVariable p) case "failed" => p::%
+        symbolIfCan(k := v::K) case SY => p::%
+        g := (op := operator k)
+           (arg := [eval(a,lop,lexp,lfunc) for a in argument k]$List(%))
+        q := map(y+->eval(y::%, lop, lexp, lfunc),
+                 univariate(p, k))$SparseUnivariatePolynomialFunctions2(MP, %)
+        (n := position(name op, lop)) < minIndex lop => q g
+        a:%  := 0
+        f    := eval((lfunc.n) arg, lop, lexp, lfunc)
+        e    := lexp.n
+        while q ^= 0 repeat
+          m  := degree q
+          qr := divide(m, e)
+          t1 := f ** (qr.quotient)::N
+          t2 := g ** (qr.remainder)::N
+          a  := a + leadingCoefficient(q) * t1 * t2
+          q  := reductum q
+        a
 
-}
+      dispdiff : List % -> Record(name:O, sub:O, arg:List O, level:N)
+      dispdiff l ==
+        s := second(l)::O
+        t := third(l)::O
+        a := argument(k := retract(first l)@K)
+        is?(k, opdiff) =>
+          rec := dispdiff a
+          i   := position(s, rec.arg)
+          rec.arg.i := t
+          [rec.name,
+             hconcat(rec.sub, hconcat(","::SY::O, (i+1-minIndex a)::O)),
+                        rec.arg, (zero?(rec.level) => 0; rec.level + 1)]
+        i   := position(second l, a)
+        m   := [x::O for x in a]$List(O)
+        m.i := t
+        [name(operator k)::O, hconcat(","::SY::O, (i+1-minIndex a)::O),
+                                             m, (empty? rest a => 1; 0)]
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\pagehead{PseudoAlgebraicClosureOfPerfectFieldCategory}{PACPERC}
-\pagepic{ps/v102pseudoalgebraicclosureofperfectfieldcategory.ps}{PACPERC}{0.50}
+      ddiff : List % -> O
+      ddiff l ==
+        rec := dispdiff l
+        opname :=
+          zero?(rec.level) => sub(rec.name, rec.sub)
+          differentiate(rec.name, rec.level)
+        prefix(opname, rec.arg)
 
-\begin{chunk}{PseudoAlgebraicClosureOfPerfectFieldCategory.input}
-)set break resume
-)sys rm -f PseudoAlgebraicClosureOfPerfectFieldCategory.output
-)spool PseudoAlgebraicClosureOfPerfectFieldCategory.output
-)set message test on
-)set message auto off
-)clear all
+      substArg : (OP, List %, Z, %) -> %
+      substArg(op, l, i, g) ==
+        z := copy l
+        z.i := g
+        kernel(op, z)
 
---S 1 of 1
-)show PseudoAlgebraicClosureOfPerfectFieldCategory
---R 
---R PseudoAlgebraicClosureOfPerfectFieldCategory  is a category constructor
---R Abbreviation for PseudoAlgebraicClosureOfPerfectFieldCategory is PACPERC 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.2.pamphlet to see algebra source code for PACPERC 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (Fraction(Integer),%) -> %      ?*? : (%,Fraction(Integer)) -> %
---R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
---R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?/? : (%,%) -> %                      ?=? : (%,%) -> Boolean
---R 1 : () -> %                           0 : () -> %
---R ?^? : (%,Integer) -> %                ?^? : (%,NonNegativeInteger) -> %
---R ?^? : (%,PositiveInteger) -> %        associates? : (%,%) -> Boolean
---R coerce : Fraction(Integer) -> %       coerce : % -> %
---R coerce : Integer -> %                 coerce : % -> OutputForm
---R conjugate : % -> %                    extDegree : % -> PositiveInteger
---R factor : % -> Factored(%)             fullOutput : % -> OutputForm
---R gcd : List(%) -> %                    gcd : (%,%) -> %
---R ground? : % -> Boolean                hash : % -> SingleInteger
---R inv : % -> %                          latex : % -> String
---R lcm : List(%) -> %                    lcm : (%,%) -> %
---R maxTower : List(%) -> %               one? : % -> Boolean
---R previousTower : % -> %                prime? : % -> Boolean
---R ?quo? : (%,%) -> %                    recip : % -> Union(%,"failed")
---R ?rem? : (%,%) -> %                    sample : () -> %
---R setTower! : % -> Void                 sizeLess? : (%,%) -> Boolean
---R squareFree : % -> Factored(%)         squareFreePart : % -> %
---R unit? : % -> Boolean                  unitCanonical : % -> %
---R vectorise : (%,%) -> Vector(%)        zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R characteristic : () -> NonNegativeInteger
---R definingPolynomial : % -> SparseUnivariatePolynomial(%)
---R definingPolynomial : () -> SparseUnivariatePolynomial(%)
---R distinguishedRootsOf : (SparseUnivariatePolynomial(%),%) -> List(%)
---R divide : (%,%) -> Record(quotient: %,remainder: %)
---R euclideanSize : % -> NonNegativeInteger
---R expressIdealMember : (List(%),%) -> Union(List(%),"failed")
---R exquo : (%,%) -> Union(%,"failed")
---R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
---R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
---R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
---R lift : (%,%) -> SparseUnivariatePolynomial(%)
---R lift : % -> SparseUnivariatePolynomial(%)
---R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
---R newElement : (SparseUnivariatePolynomial(%),Symbol) -> %
---R newElement : (SparseUnivariatePolynomial(%),%,Symbol) -> %
---R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
---R reduce : SparseUnivariatePolynomial(%) -> %
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
---R
---E 1
+      diffdiff : (List %, SY) -> %
+      diffdiff(l, x) ==
+        f := kernel(opdiff, l)
+        diffdiff0(l, x, f, retract(f)@K, empty())
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{PseudoAlgebraicClosureOfPerfectFieldCategory.help}
-====================================================================
-PseudoAlgebraicClosureOfPerfectFieldCategory examples
-====================================================================
+      diffdiff0 : (List %, SY, %, K, List %) -> %
+      diffdiff0(l, x, expr, kd, done) ==
+        op  := operator(k := retract(first l)@K)
+        gg  := second l
+        u   := third l
+        arg := argument k
+        ans:% := 0
+        if (not member?(u,done)) and (ans := differentiate(u,x))^=0 then
+          ans := ans * kernel(opdiff,
+               [subst(expr, [kd], [kernel(opdiff, [first l, gg, gg])]),
+                             gg, u])
+        done := concat(gg, done)
+        is?(k, opdiff) => ans + diffdiff0(arg, x, expr, k, done)
+        for i in minIndex arg .. maxIndex arg for b in arg repeat
+          if (not member?(b,done)) and (bp:=differentiate(b,x))^=0 then
+            g   := symsub(gendiff, i)::%
+            ans := ans + bp * kernel(opdiff, [subst(expr, [kd],
+             [kernel(opdiff, [substArg(op, arg, i, g), gg, u])]), g, b])
+        ans
 
-This category exports the function for domains which implement dynamic 
-extension using the simple notion of tower extensions. A tower extension 
-T of the ground field K is any sequence of field extensions
-    (T : K_0, K_1, ..., K_i...,K_n) where K_0 = K 
-and for 
-    i =1,2,...,n, K_i is an extension of K_{i-1} of degree > 1 
-and defined by an irreducible polynomial p(Z) in K_{i-1}.
+      dfeval : (List %, K) -> %
+      dfeval(l, g) ==
+        eval(differentiate(first l, symbolIfCan(g)::SY), g, third l)
 
-Two towers 
-    (T_1: K_01, K_11,...,K_i1,...,K_n1)  
-and 
-    (T_2: K_02, K_12,...,K_i2,...,K_n2)
-are said to be related if 
-    T_1 <= T_2 (or T_1 >= T_2), 
-that is if 
-    K_i1 = K_i2 for i=1,2,...,n1 (or i=1,2,...,n2). 
+      diffEval : List % -> %
+      diffEval l ==
+        k:K
+        g := retract(second l)@K
+        ((u := retractIfCan(first l)@Union(K, "failed")) case "failed")
+          or (u case K and symbolIfCan(k := u::K) case SY) => dfeval(l, g)
+        op := operator k
+        (ud := derivative op) case "failed" => 
+             -- possible trouble 
+             -- make sure it is a dummy var  
+             dumm:%:=symsub(gendiff,1)::%
+             ss:=subst(l.1,l.2=dumm)
+             -- output(nl::OutputForm)$OutputPackage
+             -- output("fixed"::OutputForm)$OutputPackage
+             nl:=[ss,dumm,l.3]
+             kernel(opdiff, nl)
+        (n := position(second l,argument k)) < minIndex l => 
+              dfeval(l,g)
+        d := ud::List(List % -> %)
+        eval((d.n)(argument k), g, third l)
 
-Any algebraic operations defined for several elements are only defined 
-if all of the concerned elements are coming from a set of related tower 
-extensions. 
+      diffArg : (List %, OP, N) -> List %
+      diffArg(l, op, i) ==
+        n := i - 1 + minIndex l
+        z := copy l
+        z.n := g := symsub(gendiff, n)::%
+        [kernel(op, z), g, l.n]
 
-See Also:
-o )show PseudoAlgebraicClosureOfPerfectFieldCategory
+      opderiv : (OP, N) -> List(List % -> %)
+      opderiv(op, n) ==
+        (n = 1) =>
+          g := symsub(gendiff, n)::%
+          [x +-> kernel(opdiff,[kernel(op, g), g, first x])]
+        [y +-> kernel(opdiff, diffArg(y, op, i)) for i in 1..n]
 
-\end{chunk}
+      kderiv : K -> List %
+      kderiv k ==
+        zero?(n := #(args := argument k)) => empty()
+        op := operator k
+        grad :=
+          (u := derivative op) case "failed" => opderiv(op, n)
+          u::List(List % -> %)
+        if #grad ^= n then grad := opderiv(op, n)
+        [g args for g in grad]
 
-\pagefrom{Field}{FIELD}
+    -- SPECIALDIFF contains a map (List %, Symbol) -> %
+    -- it is used when the usual chain rule does not apply,
+    -- for instance with implicit algebraics.
 
-{\bf Exports:}\\
-\begin{tabular}{llll}
-\cross{PACPERC}{0} &
-\cross{PACPERC}{1} &
-\cross{PACPERC}{associates?} &
-\cross{PACPERC}{characteristic} \\
-\cross{PACPERC}{coerce} &
-\cross{PACPERC}{conjugate} &
-\cross{PACPERC}{definingPolynomial} &
-\cross{PACPERC}{distinguishedRootsOf} \\
-\cross{PACPERC}{divide} &
-\cross{PACPERC}{euclideanSize} &
-\cross{PACPERC}{expressIdealMember} &
-\cross{PACPERC}{exquo} \\
-\cross{PACPERC}{extDegree} &
-\cross{PACPERC}{extendedEuclidean} &
-\cross{PACPERC}{factor} &
-\cross{PACPERC}{fullOutput} \\
-\cross{PACPERC}{gcd} &
-\cross{PACPERC}{gcdPolynomial} &
-\cross{PACPERC}{ground?} &
-\cross{PACPERC}{hash} \\
-\cross{PACPERC}{inv} &
-\cross{PACPERC}{latex} &
-\cross{PACPERC}{lcm} &
-\cross{PACPERC}{lift} \\
-\cross{PACPERC}{maxTower} &
-\cross{PACPERC}{multiEuclidean} &
-\cross{PACPERC}{newElement} &
-\cross{PACPERC}{one?} \\
-\cross{PACPERC}{previousTower} &
-\cross{PACPERC}{prime?} &
-\cross{PACPERC}{principalIdeal} &
-\cross{PACPERC}{?quo?} \\
-\cross{PACPERC}{recip} &
-\cross{PACPERC}{reduce} &
-\cross{PACPERC}{?rem?} &
-\cross{PACPERC}{sample} \\
-\cross{PACPERC}{setTower!} &
-\cross{PACPERC}{sizeLess?} &
-\cross{PACPERC}{squareFree} &
-\cross{PACPERC}{squareFreePart} \\
-\cross{PACPERC}{subtractIfCan} &
-\cross{PACPERC}{unit?} &
-\cross{PACPERC}{unitCanonical} &
-\cross{PACPERC}{unitNormal} \\
-\cross{PACPERC}{vectorise} &
-\cross{PACPERC}{zero?} &
-\cross{PACPERC}{?*?} &
-\cross{PACPERC}{?**?} \\
-\cross{PACPERC}{?+?} &
-\cross{PACPERC}{?-?} &
-\cross{PACPERC}{-?} &
-\cross{PACPERC}{?/?} \\
-\cross{PACPERC}{?=?} &
-\cross{PACPERC}{?\^{}?} &
-\cross{PACPERC}{?\~{}=?} &
-\end{tabular} 
+      kerderiv : (K, SY)  -> %
+      kerderiv(k, x) ==
+        (v := symbolIfCan(k)) case SY =>
+          v::SY = x => 1
+          0
+        (fn := property(operator k, SPECIALDIFF)) case None =>
+           ((fn::None) pretend ((List %, SY) -> %)) (argument k, x)
+        +/[g * differentiate(y,x) for g in kderiv k for y in argument k]
 
-{\bf Attributes Exported:}
-\begin{itemize}
-\item {\bf \cross{PACPERC}{canonicalUnitNormal}}
-is true if we can choose a canonical representative for each class 
-of associate elements, that is {\tt associates?(a,b)} returns true 
-if and only if {\tt unitCanonical(a) = unitCanonical(b)}.
-\item {\bf \cross{PACPERC}{canonicalsClosed}}
-is true if\hfill\\
-{\tt unitCanonical(a)*unitCanonical(b) = unitCanonical(a*b)}.
-\item {\bf \cross{PACPERC}{noZeroDivisors}}
-is true if $x * y \ne 0$ implies both x and y are non-zero.
-\item {\bf \cross{PACPERC}{commutative(``*'')}}
-is true if it has an operation $"*": (D,D) -> D$
-which is commutative.
-\item {\bf \cross{PACPERC}{unitsKnown}}
-is true if a monoid (a multiplicative semigroup with a 1) has 
-unitsKnown means that  the operation {\tt recip} can only return 
-``failed'' if its argument is not a unit.
-\item {\bf \cross{PACPERC}{leftUnitary}}
-is true if $1 * x = x$ for all x.
-\item {\bf \cross{PACPERC}{rightUnitary}}
-is true if $x * 1 = x$ for all x.
-\end{itemize}
+      smpderiv : (MP, SY) -> %
+      smpderiv(p, x) ==
+        map((s:R):R +-> retract differentiate(s::PR, x), p)::% +
+         +/[differentiate(p,k)::% * kerderiv(k, x) for k in variables p]
 
-These are directly exported but not implemented:
-\begin{verbatim}
-  conjugate: % -> %
-  definingPolynomial: () -> SUP(%)
-  definingPolynomial: % -> SUP %
-  distinguishedRootsOf: (SparseUnivariatePolynomial %,%) -> List %
-  extDegree: % -> PI
-  fullOutput: % -> OutputForm
-  ground_? : % -> Boolean
-  lift: % -> SUP(%)
-  lift: (%,%) -> SUP(%)
-  maxTower: List % -> %
-  newElement: (SUP(%), %, Symbol) -> %
-  newElement: (SUP(%), Symbol) -> %
-  previousTower: % -> %
-  reduce: SUP(%) -> %
-  setTower_!: % -> Void
-  vectorise: (%,%) -> Vector(%)
-\end{verbatim}
+      coerce : Polynomial(R) -> %
+      coerce(p:PR):% ==
+        map(s +-> s::%, r +-> r::%, p)$PolynomialCategoryLifting(
+                                      IndexedExponents SY, SY, R, PR, %)
 
-These exports come from \refto{Field}():
-\begin{verbatim}
- associates? : (%,%) -> Boolean       
- divide : (%,%) -> Record(quotient: %,remainder: %)
- euclideanSize : % -> NonNegativeInteger
- exquo : (%,%) -> Union(%,"failed")
- factor : % -> Factored %
- gcd : (%,%) -> %                     
- inv : % -> %
- prime? : % -> Boolean
- squareFree : % -> Factored %
- unitCanonical : % -> %               
- unitNormal : % -> Record(unit: %,canonical: %,associate: %)
- ?/? : (%,%) -> %                     
-\end{verbatim}
+      worse? : (K, K) -> Boolean
+      worse?(k1, k2) ==
+        (u := less?(name operator k1,name operator k2)) case "failed" =>
+          k1 < k2
+        u::Boolean
 
-These exports come from \refto{EuclideanDomain}():
-\begin{verbatim}
- 0 : () -> %
- 1 : () -> %                          
- characteristic : () -> NonNegativeInteger
- coerce : % -> %                      
- coerce : Integer -> %
- coerce : % -> OutputForm             
- expressIdealMember : (List %,%) -> Union(List %,"failed")
- extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
- extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
- gcd : List % -> %
- gcdPolynomial : (SparseUnivariatePolynomial %,
-                  SparseUnivariatePolynomial %) ->
-                    SparseUnivariatePolynomial %
- hash : % -> SingleInteger            
- latex : % -> String                  
- lcm : List % -> %
- lcm : (%,%) -> %                     
- multiEuclidean : (List %,%) -> Union(List %,"failed")
- one? : % -> Boolean
- principalIdeal : List % -> Record(coef: List %,generator: %)
- recip : % -> Union(%,"failed")
- sample : () -> %                     
- sizeLess? : (%,%) -> Boolean         
- subtractIfCan : (%,%) -> Union(%,"failed")
- unit? : % -> Boolean
- zero? : % -> Boolean                 
- ?+? : (%,%) -> %
- ?=? : (%,%) -> Boolean
- ?~=? : (%,%) -> Boolean
- ?*? : (%,%) -> %                     
- ?*? : (Integer,%) -> %
- ?*? : (PositiveInteger,%) -> %       
- ?*? : (NonNegativeInteger,%) -> %
- ?-? : (%,%) -> %                     
- -? : % -> %
- ?**? : (%,PositiveInteger) -> %      
- ?**? : (%,NonNegativeInteger) -> %
- ?^? : (%,PositiveInteger) -> %
- ?^? : (%,NonNegativeInteger) -> %
- ?quo? : (%,%) -> %                   
- ?rem? : (%,%) -> %
-\end{verbatim}
+      bestKernel: List K -> K
+      bestKernel l ==
+        empty? rest l => first l
+        a := bestKernel rest l
+        worse?(first l, a) => a
+        first l
 
-These exports come from \refto{UniqueFactorizationDomain}():
-\begin{verbatim}
- squareFreePart : % -> %
-\end{verbatim}
+      smp2O : MP -> O
+      smp2O p ==
+        (r:=retractIfCan(p)@Union(R,"failed")) case R =>r::R::OutputForm
+        a :=
+          userOrdered?() => bestKernel variables p
+          mainVariable(p)::K
+        outputForm(map((x:MP):% +-> x::%, univariate(p, a))_
+            $SparseUnivariatePolynomialFunctions2(MP, %), a::OutputForm)
 
+      smpsubst : (MP, List K, List %) -> %
+      smpsubst(p, lk, lv) ==
+        map(x +-> match(lk, lv, x,
+            notfound((z:K):%+->subs(s+->subst(s, lk, lv), z), lk, x))_
+             $ListToMap(K,%),y+->y::%,p)_
+              $PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%)
 
-These exports come from \refto{DivisionRing}():
-\begin{verbatim}
- coerce : Fraction Integer -> %
- ?*? : (Fraction Integer,%) -> %      
- ?*? : (%,Fraction Integer) -> %
- ?**? : (%,Integer) -> %
- ?^? : (%,Integer) -> %               
-\end{verbatim}
+      smpeval : (MP, List K, List %) -> %
+      smpeval(p, lk, lv) ==
+        map(x +-> match(lk, lv, x,
+            notfound((z:K):%+->map(s+->eval(s,lk,lv),z),lk,x))_
+             $ListToMap(K,%),y+->y::%,p)_
+              $PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%)
 
-\begin{chunk}{category PACPERC PseudoAlgebraicClosureOfPerfectFieldCategory}
-)abbrev category PACPERC PseudoAlgebraicClosureOfPerfectFieldCategory
-++ Authors: Gaetan Hache
-++ Date Created: may 1997 
-++ Date Last Updated: April 2010, by Tim Daly
-++ Description: 
-++ This category exports the function for domains 
-++ which implement dynamic extension using the simple notion of tower 
-++ extensions. ++ A tower extension T  of the ground
-++ field K is any sequence of field extension 
-++ (T : K_0, K_1, ..., K_i...,K_n) where K_0 = K 
-++ and for i =1,2,...,n, K_i is an extension of K_{i-1} of degree > 1 
-++ and defined by an irreducible polynomial p(Z) in K_{i-1}.
-++ Two towers (T_1: K_01, K_11,...,K_i1,...,K_n1)  
-++ and (T_2: K_02, K_12,...,K_i2,...,K_n2)
-++ are said to be related if T_1 <= T_2 (or T_1 >= T_2), 
-++ that is if K_i1 = K_i2 for i=1,2,...,n1 (or i=1,2,...,n2). 
-++ Any algebraic operations defined for several elements 
-++ are only defined if all of the concerned elements are coming from 
-++ a set of related tower extensions. 
-PseudoAlgebraicClosureOfPerfectFieldCategory() : Category == PUB where
+-- this is called on k when k is not a member of lk
 
- INT      ==> Integer
- K        ==> Fraction Integer
- NNI      ==> NonNegativeInteger
- SUP      ==> SparseUnivariatePolynomial
- BOOLEAN  ==> Boolean
- PI       ==> PositiveInteger
- FFFACTSE ==> FiniteFieldFactorizationWithSizeParseBySideEffect
+      notfound : (K -> %, List K, K) -> %
+      notfound(fn, lk, k) ==
+        empty? setIntersection(tower(f := k::%), lk) => f
+        fn k
 
- PUB ==> Field with 
+      if R has ConvertibleTo InputForm then
 
-  definingPolynomial: () -> SUP(%)
-  definingPolynomial: % -> SUP %
+        pushunq : (List SY, List %) -> List %
+        pushunq(l, arg) ==
+           empty? l => [eval a for a in arg]
+           [eval(a, l) for a in arg]
 
-  lift: % -> SUP(%)
-  lift: (%,%) -> SUP(%)
-  reduce: SUP(%) -> %
+        kunq : (K, List SY, Boolean) -> %
+        kunq(k, l, givenlist?) ==
+          givenlist? and empty? l => k::%
+          is?(k, opquote) and
+            (member?(s:=retract(first argument k)@SY, l) or empty? l) =>
+              interpret(convert(concat(convert(s)@InputForm,
+                [convert a for a in pushunq(l, rest argument k)
+                   ]@List(InputForm)))@InputForm)$InputFormFunctions1(%)
+          (operator k) pushunq(l, argument k)
 
-  distinguishedRootsOf: (SparseUnivariatePolynomial %,%) -> List %
-    ++ distinguishedRootsOf(p,a) returns a (distinguised) root for each
-    ++ irreducible factor of the polynomial p (factored over the field defined
-    ++ by the element a). 
-  
-  ground_? : % -> Boolean
-  maxTower: List % -> %
-    ++ maxTower(l) returns the tower in the list having the maximal extension 
-    ++ degree over the ground field. It has no meaning if the towers are 
-    ++ not related.
-  extDegree: % -> PI
-    ++ extDegree(a) returns the extension degree of the extension tower 
-    ++ over which the element is defined.
-  previousTower: % -> %
-    ++ previousTower(a) returns the previous tower extension over which
-    ++ the element a is defined.
+        smpunq : (MP, List SY, Boolean) -> %
+        smpunq(p, l, givenlist?) ==
+          givenlist? and empty? l => p::%
+          map(x +-> kunq(x, l, givenlist?), y+->y::%, p)_
+            $PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%)
 
-  vectorise: (%,%) -> Vector(%)
+      smpret : MP -> Union(PR, "failed")
+      smpret p ==
+        "or"/[symbolIfCan(k) case "failed" for k in variables p] =>
+          "failed"
+        map(x+->symbolIfCan(x)::SY::PR, y+->y::PR,p)_
+          $PolynomialCategoryLifting(IndexedExponents K, K, R, MP, PR)
 
-  conjugate: % -> %
-  newElement: (SUP(%), %, Symbol) -> %
-  newElement: (SUP(%), Symbol) -> %
-  setTower_!: % -> Void
-  fullOutput: % -> OutputForm
+      isExpt : (%,BasicOperator) ->
+         Union(Record(var: Kernel(%),exponent: Integer),"failed")
+      isExpt(x:%, op:OP) ==
+        (u := isExpt x) case "failed" => "failed"
+        is?((u::Record(var:K, exponent:Z)).var, op) => u
+        "failed"
+
+      isExpt : (%,Symbol) ->
+         Union(Record(var: Kernel(%),exponent: Integer),"failed")
+      isExpt(x:%, sy:SY) ==
+        (u := isExpt x) case "failed" => "failed"
+        is?((u::Record(var:K, exponent:Z)).var, sy) => u
+        "failed"
+
+      if R has RetractableTo Z then
+
+          smpIsMult : MP -> Union(Record(coef:Z, var:K),"failed")
+          smpIsMult p ==
+            (u := mainVariable p) case K and (degree(q:=univariate(p,u::K))=1)
+              and zero?(leadingCoefficient reductum q)
+                and ((r:=retractIfCan(leadingCoefficient q)@Union(R,"failed"))
+                   case R)
+                     and (n := retractIfCan(r::R)@Union(Z, "failed")) case Z =>
+                       [n::Z, u::K]
+            "failed"
+
+      debugA: (List % ,List %,Boolean) -> Boolean
+      debugA(a1,a2,t) == 
+         -- uncomment for debugging
+         -- output(hconcat [a1::OutputForm,_
+         --                 a2::OutputForm,t::OutputForm])$OutputPackage
+         t
+
+      equaldiff : (K,K)->Boolean
+      equaldiff(k1,k2) ==
+        a1:=argument k1
+        a2:=argument k2
+        -- check the operator
+        res:=operator k1 = operator k2 
+        not res => debugA(a1,a2,res) 
+        -- check the evaluation point
+        res:= (a1.3 = a2.3)
+        not res => debugA(a1,a2,res)
+        -- check all the arguments
+        res:= (a1.1 = a2.1) and (a1.2 = a2.2)
+        res => debugA(a1,a2,res)
+        -- check the substituted arguments
+        (subst(a1.1,[retract(a1.2)@K],[a2.2]) = a2.1) => debugA(a1,a2,true)
+        debugA(a1,a2,false)
+
+      setProperty(opdiff,SPECIALEQUAL,
+                          equaldiff@((K,K) -> Boolean) pretend None)
+
+      setProperty(opdiff, SPECIALDIFF,
+                          diffdiff@((List %, SY) -> %) pretend None)
+
+      setProperty(opdiff, SPECIALDISP,
+                              ddiff@(List % -> OutputForm) pretend None)
+
+      if not(R has IntegralDomain) then
+
+        mainKernel : % -> Union(Kernel(%),"failed")
+        mainKernel x == mainVariable numer x
+
+        kernels : % -> List(Kernel(%))
+        kernels x == variables numer x
+
+        retract : % -> R
+        retract(x:%):R == retract numer x
+
+        retract : % -> Polynomial(R)
+        retract(x:%):PR == smpret(numer x)::PR
+
+        retractIfCan : % -> Union(Fraction(Integer),"failed")
+        retractIfCan(x:%):Union(R, "failed") == retract numer x
+
+        retractIfCan : % -> Union(Polynomial(R),"failed")
+        retractIfCan(x:%):Union(PR, "failed") == smpret numer x
+
+        eval : (%,List(Kernel(%)),List(%)) -> %
+        eval(x:%, lk:List K, lv:List %)  == smpeval(numer x, lk, lv)
+
+        subst : (%,List(Kernel(%)),List(%)) -> %
+        subst(x:%, lk:List K, lv:List %) == smpsubst(numer x, lk, lv)
+
+        differentiate : (%,Symbol) -> %
+        differentiate(x:%, s:SY) == smpderiv(numer x, s)
+
+        coerce : % -> OutputForm
+        coerce(x:%):OutputForm == smp2O numer x
+
+        if R has ConvertibleTo InputForm then
+
+          eval(f:%, l:List SY) == smpunq(numer f, l, true)
+
+          eval f == smpunq(numer f, empty(), false)
+
+        eval : (%,List(Symbol),List(NonNegativeInteger),List((List(%) -> %)))
+            -> %
+        eval(x:%, s:List SY, n:List N, f:List(List % -> %)) ==
+          smprep(s, n, f, numer x)
+
+        isPlus : % -> Union(List(%),"failed")
+        isPlus x ==
+          (u := isPlus numer x) case "failed" => "failed"
+          [p::% for p in u::List(MP)]
+
+        isTimes : % -> Union(List(%),"failed")
+        isTimes x ==
+          (u := isTimes numer x) case "failed" => "failed"
+          [p::% for p in u::List(MP)]
+
+        isExpt : % -> Union(Record(var: Kernel(%),exponent: Integer),"failed")
+        isExpt x ==
+          (u := isExpt numer x) case "failed" => "failed"
+          r := u::Record(var:K, exponent:NonNegativeInteger)
+          [r.var, r.exponent::Z]
+
+        isPower : % -> Union(Record(val: %,exponent: Integer),"failed")
+        isPower x ==
+          (u := isExpt numer x) case "failed" => "failed"
+          r := u::Record(var:K, exponent:NonNegativeInteger)
+          [r.var::%, r.exponent::Z]
+
+        if R has ConvertibleTo Pattern Z then
+
+          convert : % -> Pattern(Integer)
+          convert(x:%):Pattern(Z) == convert numer x
+
+        if R has ConvertibleTo Pattern Float then
+
+          convert : % -> Pattern(Float)
+          convert(x:%):Pattern(Float) == convert numer x
+
+        if R has RetractableTo Z then
+
+          isMult : % -> Union(Record(coef: Integer,var: Kernel(%)),"failed")
+          isMult x == smpIsMult numer x
+
+    if R has CommutativeRing then
+
+      ?*? : (R,%) -> %
+      r:R * x:% == r::MP::% * x
+
+    if R has IntegralDomain then
+
+      mainKernel : % -> Union(Kernel(%),"failed")
+      mainKernel x == mainVariable(x)$QF
+
+      kernels : % -> List(Kernel(%))
+      kernels x == variables(x)$QF
+
+      univariate : (%,Kernel(%)) -> Fraction(SparseUnivariatePolynomial(%))
+      univariate(x:%, k:K) == univariate(x, k)$QF
+
+      isPlus : % -> Union(List(%),"failed")
+      isPlus x == isPlus(x)$QF
+
+      isTimes : % -> Union(List(%),"failed")
+      isTimes x == isTimes(x)$QF
+
+      isExpt : % -> Union(Record(var: Kernel(%),exponent: Integer),"failed")
+      isExpt x == isExpt(x)$QF
+
+      isPower : % -> Union(Record(val: %,exponent: Integer),"failed")
+      isPower x == isPower(x)$QF
+
+      denominator : % -> %
+      denominator x == denom(x)::%
+
+      coerce : Fraction(R) -> %
+      coerce(q:Q):% == (numer q)::MP / (denom q)::MP
+
+      coerce : Fraction(Polynomial(R)) -> %
+      coerce(q:Fraction PR):% == (numer q)::% / (denom q)::%
+
+      coerce : Fraction(Polynomial(Fraction(R))) -> %
+      coerce(q:Fraction Polynomial Q) == (numer q)::% / (denom q)::%
+
+      retract : % -> Polynomial(R)
+      retract(x:%):PR == retract(retract(x)@Fraction(PR))
+
+      retract : % -> Fraction(Polynomial(R))
+      retract(x:%):Fraction(PR) == smpret(numer x)::PR / smpret(denom x)::PR
+
+      retract : % -> R
+      retract(x:%):R == (retract(numer x)@R exquo retract(denom x)@R)::R
+
+      coerce : % -> OutputForm
+      coerce(x:%):OutputForm ==
+        ((denom x) = 1) => smp2O numer x
+        smp2O(numer x) / smp2O(denom x)
+
+      retractIfCan : % -> Union(R,"failed")
+      retractIfCan(x:%):Union(R,"failed") ==
+        (n := retractIfCan(numer x)@Union(R, "failed")) case "failed" or
+          (d := retractIfCan(denom x)@Union(R, "failed")) case "failed"
+            or (r := n::R exquo d::R) case "failed" => "failed"
+        r::R
+
+      eval : (%,Symbol) -> %
+      eval(f:%, l:List SY) ==
+        smpunq(numer f, l, true) / smpunq(denom f, l, true)
+
+      if R has ConvertibleTo InputForm then
+
+        eval : % -> %
+        eval f ==
+          smpunq(numer f, empty(), false) / smpunq(denom f, empty(), false)
+
+        eval : (%,List(Symbol),List(NonNegativeInteger),List((% -> %))) -> %
+        eval(x:%, s:List SY, n:List N, f:List(List % -> %)) ==
+          smprep(s, n, f, numer x) / smprep(s, n, f, denom x)
+
+      differentiate : (%,Symbol) -> %
+      differentiate(f:%, x:SY) ==
+        (smpderiv(numer f, x) * denom(f)::% -
+          numer(f)::% * smpderiv(denom f, x))
+            / (denom(f)::% ** 2)
+
+      eval : (%,List(%),List(%)) -> %
+      eval(x:%, lk:List K, lv:List %) ==
+        smpeval(numer x, lk, lv) / smpeval(denom x, lk, lv)
+
+      subst : (%,List(Kernel(%)),List(%)) -> %
+      subst(x:%, lk:List K, lv:List %) ==
+        smpsubst(numer x, lk, lv) / smpsubst(denom x, lk, lv)
+
+      par : % -> %
+      par x ==
+        (r := retractIfCan(x)@Union(R, "failed")) case R => x
+        paren x
+
+      convert : Factored(%) -> %
+      convert(x:Factored %):% ==
+        par(unit x) * */[par(f.factor) ** f.exponent for f in factors x]
+
+      retractIfCan : % -> Union(Polynomial(R),"failed")
+      retractIfCan(x:%):Union(PR, "failed") ==
+        (u := retractIfCan(x)@Union(Fraction PR,"failed")) case "failed"
+          => "failed"
+        retractIfCan(u::Fraction(PR))
+
+      retractIfCan : % -> Union(Fraction(Polynomial(R)),"failed")
+      retractIfCan(x:%):Union(Fraction PR, "failed") ==
+        (n := smpret numer x) case "failed" => "failed"
+        (d := smpret denom x) case "failed" => "failed"
+        n::PR / d::PR
+
+      coerce : Polynomial(Fraction(R)) ->
+      coerce(p:Polynomial Q):% ==
+        map(x+->x::%, y+->y::%,p)_
+         $PolynomialCategoryLifting(IndexedExponents SY, SY,
+                                                     Q, Polynomial Q, %)
+
+      if R has RetractableTo Z then
+
+       coerce : Fraction(Integer) -> %
+       coerce(x:Fraction Z):% == numer(x)::MP / denom(x)::MP
+
+        isMult : % -> Union(Record(coef: Integer,var: Kernel(%)),"failed")
+        isMult x ==
+           (u := smpIsMult numer x) case "failed"
+              or (v := retractIfCan(denom x)@Union(R, "failed")) case "failed"
+                 or (w := retractIfCan(v::R)@Union(Z, "failed")) case "failed"
+                     => "failed"
+           r := u::Record(coef:Z, var:K)
+           (q := r.coef exquo w::Z) case "failed" => "failed"
+           [q::Z, r.var]
+
+      if R has ConvertibleTo Pattern Z then
+
+        convert : % -> Pattern(Integer)
+        convert(x:%):Pattern(Z) == convert(numer x) / convert(denom x)
+
+      if R has ConvertibleTo Pattern Float then
+
+        convert : % -> Pattern(Float)
+        convert(x:%):Pattern(Float) ==
+          convert(numer x) / convert(denom x)
+*)
 
 \end{chunk}
-\begin{chunk}{PACPERC.dotabb}
-"PACPERC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACPERC"];
-"PACPERC" -> "FIELD"
+
+\begin{chunk}{FS.dotabb}
+"FS"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=FS"];
+"FS" -> "ES"
+"FS" -> "FPATMAB"
+"FS" -> "FRETRCT"
+"FS" -> "PATAB"
+"FS" -> "RETRACT"
+"FS" -> "KONVERT"
+"FS" -> "MONOID"
+"FS" -> "GROUP"
+"FS" -> "ABELMON"
+"FS" -> "ABELGRP"
+"FS" -> "PDRING"
+"FS" -> "FLINEXP"
+"FS" -> "CHARNZ"
+"FS" -> "INTDOM"
+"FS" -> "FIELD"
 
 \end{chunk}
-\begin{chunk}{PACPERC.dotfull}
-"PseudoAlgebraicClosureOfPerfectFieldCategory"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=PACPERC"];
-"PseudoAlgebraicClosureOfPerfectFieldCategory" -> "Field()"
+\begin{chunk}{FS.dotfull}
+"FunctionSpace(a:OrderedSet)"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=FS"];
+"FunctionSpace(a:OrderedSet)" -> "ExpressionSpace()"
+"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Symbol)"
+"FunctionSpace(a:OrderedSet)" -> "Patternable(OrderedSet)"
+"FunctionSpace(a:OrderedSet)" -> "FullyPatternMatchable(OrderedSet)"
+"FunctionSpace(a:OrderedSet)" -> "FullyRetractableTo(OrderedSet)"
+"FunctionSpace(a:OrderedSet)" -> "ConvertibleTo(InputForm)"
+"FunctionSpace(a:OrderedSet)" -> "Monoid()"
+"FunctionSpace(a:OrderedSet)" -> "Group()"
+"FunctionSpace(a:OrderedSet)" -> "AbelianMonoid()"
+"FunctionSpace(a:OrderedSet)" -> "AbelianGroup()"
+"FunctionSpace(a:OrderedSet)" -> "PartialDifferentialRing(Symbol)"
+"FunctionSpace(a:OrderedSet)" -> "FullyLinearlyExplicitRingOver(OrderedSet)"
+"FunctionSpace(a:OrderedSet)" -> "CharacteristicNonZero()"
+"FunctionSpace(a:OrderedSet)" -> "IntegralDomain()"
+"FunctionSpace(a:OrderedSet)" -> "Field()"
+"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Integer)"
+"FunctionSpace(a:OrderedSet)" -> "RetractableTo(Fraction(Integer))"
 
 \end{chunk}
-\begin{chunk}{PACPERC.dotpic}
+\begin{chunk}{FS.dotpic}
 digraph pic {
  fontsize=10;
  bgcolor="#ECEA81";
  node [shape=box, color=white, style=filled];
 
-"PseudoAlgebraicClosureOfPerfectFieldCategory" [color=lightblue];
-"PseudoAlgebraicClosureOfPerfectFieldCategory" -> "FIELD..."
+"FunctionSpace(a:OrderedSet)" [color=lightblue];
+"FunctionSpace(a:OrderedSet)" -> "ES..."
+"FunctionSpace(a:OrderedSet)" -> "RETRACT..."
+"FunctionSpace(a:OrderedSet)" -> "PATAB..."
+"FunctionSpace(a:OrderedSet)" -> "FPATMAB..."
+"FunctionSpace(a:OrderedSet)" -> "FRETRCT..."
+"FunctionSpace(a:OrderedSet)" -> "KONVERT..."
+"FunctionSpace(a:OrderedSet)" -> "MONOID..."
+"FunctionSpace(a:OrderedSet)" -> "GROUP..."
+"FunctionSpace(a:OrderedSet)" -> "ABELMON..."
+"FunctionSpace(a:OrderedSet)" -> "ABELGRP..."
+"FunctionSpace(a:OrderedSet)" -> "PDRING..."
+"FunctionSpace(a:OrderedSet)" -> "FLINEXP..."
+"FunctionSpace(a:OrderedSet)" -> "CHARNZ..."
+"FunctionSpace(a:OrderedSet)" -> "INTDOM..."
+"FunctionSpace(a:OrderedSet)" -> "FIELD..."
+"FunctionSpace(a:OrderedSet)" -> "RETRACT..."
 
+"ES..." [color=lightblue];
+"EVALABLE..." [color=lightblue];
+"FRETRCT..." [color=lightblue];
+"FPATMAB..." [color=lightblue];
+"IEVALAB..." [color=lightblue];
+"ORDSET..." [color=lightblue];
+"PATAB..." [color=lightblue];
+"RETRACT..." [color=lightblue];
+"KONVERT..." [color=lightblue];
+"MONOID..." [color=lightblue];
+"GROUP..." [color=lightblue];
+"ABELMON..." [color=lightblue];
+"ABELGRP..." [color=lightblue];
+"PDRING..." [color=lightblue];
+"FLINEXP..." [color=lightblue];
+"CHARNZ..." [color=lightblue];
+"INTDOM..." [color=lightblue];
 "FIELD..." [color=lightblue];
-
+"RETRACT..." [color=lightblue];
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\pagehead{QuotientFieldCategory}{QFCAT}
-\pagepic{ps/v102quotientfieldcategory.ps}{QFCAT}{0.50}
+\pagehead{InfinitlyClosePointCategory}{INFCLCT}
+\pagepic{ps/v102infinitlyclosepointcategory.eps}{INFCLCT}{0.50}
 
-\begin{chunk}{QuotientFieldCategory.input}
+\begin{chunk}{InfinitlyClosePointCategory.input}
 )set break resume
-)sys rm -f QuotientFieldCategory.output
-)spool QuotientFieldCategory.output
+)sys rm -f InfinitlyClosePointCategory.output
+)spool InfinitlyClosePointCategory.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show QuotientFieldCategory
+)show InfinitlyClosePointCategory
 --R 
---R QuotientFieldCategory(S: IntegralDomain)  is a category constructor
---R Abbreviation for QuotientFieldCategory is QFCAT 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.2.pamphlet to see algebra source code for QFCAT 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (%,S) -> %                      ?*? : (S,%) -> %
---R ?*? : (Fraction(Integer),%) -> %      ?*? : (%,Fraction(Integer)) -> %
---R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
---R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?/? : (S,S) -> %                      ?/? : (%,%) -> %
---R ?=? : (%,%) -> Boolean                D : (%,(S -> S)) -> %
---R D : % -> % if S has DIFRING           1 : () -> %
---R 0 : () -> %                           ?^? : (%,Integer) -> %
---R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R abs : % -> % if S has OINTDOM         associates? : (%,%) -> Boolean
---R ceiling : % -> S if S has INS         coerce : S -> %
---R coerce : Fraction(Integer) -> %       coerce : % -> %
---R coerce : Integer -> %                 coerce : % -> OutputForm
---R convert : % -> Float if S has REAL    denom : % -> S
---R denominator : % -> %                  differentiate : (%,(S -> S)) -> %
---R factor : % -> Factored(%)             floor : % -> S if S has INS
---R gcd : List(%) -> %                    gcd : (%,%) -> %
---R hash : % -> SingleInteger             init : () -> % if S has STEP
---R inv : % -> %                          latex : % -> String
---R lcm : List(%) -> %                    lcm : (%,%) -> %
---R map : ((S -> S),%) -> %               max : (%,%) -> % if S has ORDSET
---R min : (%,%) -> % if S has ORDSET      numer : % -> S
---R numerator : % -> %                    one? : % -> Boolean
---R prime? : % -> Boolean                 ?quo? : (%,%) -> %
---R random : () -> % if S has INS         recip : % -> Union(%,"failed")
---R ?rem? : (%,%) -> %                    retract : % -> S
---R sample : () -> %                      sizeLess? : (%,%) -> Boolean
---R squareFree : % -> Factored(%)         squareFreePart : % -> %
---R unit? : % -> Boolean                  unitCanonical : % -> %
---R wholePart : % -> S if S has EUCDOM    zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R ?<? : (%,%) -> Boolean if S has ORDSET
---R ?<=? : (%,%) -> Boolean if S has ORDSET
---R ?>? : (%,%) -> Boolean if S has ORDSET
---R ?>=? : (%,%) -> Boolean if S has ORDSET
---R D : (%,(S -> S),NonNegativeInteger) -> %
---R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL)
---R D : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL)
---R D : (%,List(Symbol)) -> % if S has PDRING(SYMBOL)
---R D : (%,Symbol) -> % if S has PDRING(SYMBOL)
---R D : (%,NonNegativeInteger) -> % if S has DIFRING
---R characteristic : () -> NonNegativeInteger
---R charthRoot : % -> Union(%,"failed") if S has CHARNZ or and(has($,CharacteristicNonZero),has(S,PolynomialFactorizationExplicit))
---R coerce : Symbol -> % if S has RETRACT(SYMBOL)
---R conditionP : Matrix(%) -> Union(Vector(%),"failed") if and(has($,CharacteristicNonZero),has(S,PolynomialFactorizationExplicit))
---R convert : % -> DoubleFloat if S has REAL
---R convert : % -> InputForm if S has KONVERT(INFORM)
---R convert : % -> Pattern(Float) if S has KONVERT(PATTERN(FLOAT))
---R convert : % -> Pattern(Integer) if S has KONVERT(PATTERN(INT))
---R differentiate : (%,(S -> S),NonNegativeInteger) -> %
---R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL)
---R differentiate : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL)
---R differentiate : (%,List(Symbol)) -> % if S has PDRING(SYMBOL)
---R differentiate : (%,Symbol) -> % if S has PDRING(SYMBOL)
---R differentiate : (%,NonNegativeInteger) -> % if S has DIFRING
---R differentiate : % -> % if S has DIFRING
---R divide : (%,%) -> Record(quotient: %,remainder: %)
---R ?.? : (%,S) -> % if S has ELTAB(S,S)
---R euclideanSize : % -> NonNegativeInteger
---R eval : (%,Symbol,S) -> % if S has IEVALAB(SYMBOL,S)
---R eval : (%,List(Symbol),List(S)) -> % if S has IEVALAB(SYMBOL,S)
---R eval : (%,List(Equation(S))) -> % if S has EVALAB(S)
---R eval : (%,Equation(S)) -> % if S has EVALAB(S)
---R eval : (%,S,S) -> % if S has EVALAB(S)
---R eval : (%,List(S),List(S)) -> % if S has EVALAB(S)
---R expressIdealMember : (List(%),%) -> Union(List(%),"failed")
---R exquo : (%,%) -> Union(%,"failed")
---R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
---R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
---R factorPolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT
---R factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT
---R fractionPart : % -> % if S has EUCDOM
---R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
---R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
---R negative? : % -> Boolean if S has OINTDOM
---R nextItem : % -> Union(%,"failed") if S has STEP
---R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if S has PATMAB(FLOAT)
---R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if S has PATMAB(INT)
---R positive? : % -> Boolean if S has OINTDOM
---R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
---R reducedSystem : Matrix(%) -> Matrix(S)
---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(S),vec: Vector(S))
---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if S has LINEXP(INT)
---R reducedSystem : Matrix(%) -> Matrix(Integer) if S has LINEXP(INT)
---R retract : % -> Integer if S has RETRACT(INT)
---R retract : % -> Fraction(Integer) if S has RETRACT(INT)
---R retract : % -> Symbol if S has RETRACT(SYMBOL)
---R retractIfCan : % -> Union(Integer,"failed") if S has RETRACT(INT)
---R retractIfCan : % -> Union(Fraction(Integer),"failed") if S has RETRACT(INT)
---R retractIfCan : % -> Union(Symbol,"failed") if S has RETRACT(SYMBOL)
---R retractIfCan : % -> Union(S,"failed")
---R sign : % -> Integer if S has OINTDOM
---R solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> Union(List(SparseUnivariatePolynomial(%)),"failed") if S has PFECAT
---R squareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
---R
+--I InfinitlyClosePointCategory(K: Field,
+--I symb: List Symbol,
+--I PolyRing: PolynomialCategory(t#1,t#4,OrderedVariableList t#2),
+--I E: DirectProductCategory(# t#2,NonNegativeInteger),
+--I ProjPt: ProjectiveSpaceCategory t#1,
+--I PCS: LocalPowerSeriesCategory t#1,
+--I Plc: PlacesCategory(t#1,t#6),
+--I DIVISOR: DivisorCategory t#7,
+--I BLMET: BlowUpMethodCategory) is a category constructor
+--I Abbreviation for InfinitlyClosePointCategory is INFCLCT 
+--I This constructor is exposed in this frame.
+--I Issue )edit bookvol10.2.pamphlet to see algebra source code for INFCLCT 
+--I
+--I------------------------------- Operations --------------------------------
+--I ?=? : (%,%) -> Boolean                actualExtensionV : % -> K
+--I chartV : % -> BLMET                   coerce : % -> OutputForm
+--I create : (ProjPt,PolyRing) -> %       degree : % -> PositiveInteger
+--I excpDivV : % -> DIVISOR               hash : % -> SingleInteger
+--I latex : % -> String                   localParamV : % -> List PCS
+--I localPointV : % -> AffinePlane K      multV : % -> NonNegativeInteger
+--I pointV : % -> ProjPt                  setchart! : (%,BLMET) -> BLMET
+--I setpoint! : (%,ProjPt) -> ProjPt      symbNameV : % -> Symbol
+--I ?~=? : (%,%) -> Boolean              
+--I create : (ProjPt,
+--I  DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),
+--I  AffinePlane K,
+--I  NonNegativeInteger,
+--I  BLMET,
+--I  NonNegativeInteger,
+--I  DIVISOR,
+--I  K,
+--I  Symbol) -> %
+--I curveV : % -> 
+--I  DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
+--I setcurve! : 
+--I  (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> 
+--I  DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
+--I setexcpDiv! : (%,DIVISOR) -> DIVISOR
+--I setlocalParam! : (%,List PCS) -> List PCS
+--I setlocalPoint! : (%,AffinePlane K) -> AffinePlane K
+--I setmult! : (%,NonNegativeInteger) -> NonNegativeInteger
+--I setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger
+--I setsymbName! : (%,Symbol) -> Symbol
+--I subMultV : % -> NonNegativeInteger
+--I
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{QuotientFieldCategory.help}
+
+\begin{chunk}{InfinitlyClosePointCategory.help}
 ====================================================================
-QuotientFieldCategory examples
+InfinitlyClosePointCategory examples
 ====================================================================
 
-QuotientField(S) is the category of fractions of an Integral Domain S.
+This category is part of the PAFF package
 
 See Also:
-o )show QuotientFieldCategory
+o )show InfinitlyClosePointCategory
 
 \end{chunk}
-{\bf See:}
 
-\pagefrom{Algebra}{ALGEBRA}
-\pagefrom{CharacteristicNonZero}{CHARNZ}
-\pagefrom{CharacteristicZero}{CHARZ}
-\pagefrom{ConvertibleTo}{KONVERT}
-\pagefrom{DifferentialExtension}{DIFEXT}
-\pagefrom{EuclideanDomain}{EUCDOM}
-\pagefrom{Field}{FIELD}
-\pagefrom{FullyEvalableOver}{FEVALAB}
-\pagefrom{FullyLinearlyExplicitRingOver}{FLINEXP}
-\pagefrom{FullyPatternMatchable}{FPATMAB}
-\pagefrom{OrderedIntegralDomain}{OINTDOM}
-\pagefrom{OrderedSet}{ORDSET}
-\pagefrom{Patternable}{PATAB}
-\pagefrom{PolynomialFactorizationExplicit}{PFECAT}
-\pagefrom{RealConstant}{REAL}
-\pagefrom{RetractableTo}{RETRACT}
-\pagefrom{StepThrough}{STEP}
+\pagefrom{SetCategoryWithDegree}{SETCATD}
 
 {\bf Exports:}\\
-
-\begin{tabular}{lllll}
-\cross{QFCAT}{0} &
-\cross{QFCAT}{1} &
-\cross{QFCAT}{abs} \\
-\cross{QFCAT}{associates?} &
-\cross{QFCAT}{ceiling} &
-\cross{QFCAT}{characteristic} \\
-\cross{QFCAT}{charthRoot} &
-\cross{QFCAT}{coerce} &
-\cross{QFCAT}{conditionP} \\
-\cross{QFCAT}{convert} &
-\cross{QFCAT}{D} &
-\cross{QFCAT}{denom} \\
-\cross{QFCAT}{denominator} &
-\cross{QFCAT}{differentiate} &
-\cross{QFCAT}{divide} \\
-\cross{QFCAT}{euclideanSize} &
-\cross{QFCAT}{eval} &
-\cross{QFCAT}{expressIdealMember} \\
-\cross{QFCAT}{exquo} &
-\cross{QFCAT}{extendedEuclidean} &
-\cross{QFCAT}{factor} \\
-\cross{QFCAT}{factorPolynomial} &
-\cross{QFCAT}{factorSquareFreePolynomial} &
-\cross{QFCAT}{floor} \\
-\cross{QFCAT}{fractionPart} &
-\cross{QFCAT}{gcd} &
-\cross{QFCAT}{gcdPolynomial} \\
-\cross{QFCAT}{hash} &
-\cross{QFCAT}{init} &
-\cross{QFCAT}{inv} \\
-\cross{QFCAT}{latex} &
-\cross{QFCAT}{lcm} &
-\cross{QFCAT}{map} \\
-\cross{QFCAT}{max} &
-\cross{QFCAT}{min} &
-\cross{QFCAT}{multiEuclidean} \\
-\cross{QFCAT}{negative?} &
-\cross{QFCAT}{nextItem} &
-\cross{QFCAT}{numer} \\
-\cross{QFCAT}{numerator} &
-\cross{QFCAT}{one?} &
-\cross{QFCAT}{patternMatch} \\
-\cross{QFCAT}{positive?} &
-\cross{QFCAT}{prime?} &
-\cross{QFCAT}{principalIdeal} \\
-\cross{QFCAT}{random} &
-\cross{QFCAT}{recip} &
-\cross{QFCAT}{reducedSystem} \\
-\cross{QFCAT}{retract} &
-\cross{QFCAT}{retractIfCan} &
-\cross{QFCAT}{sample} \\
-\cross{QFCAT}{sign} &
-\cross{QFCAT}{sizeLess?} &
-\cross{QFCAT}{solveLinearPolynomialEquation} \\
-\cross{QFCAT}{squareFree} &
-\cross{QFCAT}{squareFreePart} &
-\cross{QFCAT}{squareFreePolynomial} \\
-\cross{QFCAT}{subtractIfCan} &
-\cross{QFCAT}{unit?} &
-\cross{QFCAT}{unitNormal} \\
-\cross{QFCAT}{unitCanonical} &
-\cross{QFCAT}{wholePart} &
-\cross{QFCAT}{zero?} \\
-\cross{QFCAT}{?.?} &
-\cross{QFCAT}{?*?} &
-\cross{QFCAT}{?**?} \\
-\cross{QFCAT}{?+?} &
-\cross{QFCAT}{?-?} &
-\cross{QFCAT}{-?} \\
-\cross{QFCAT}{?/?} &
-\cross{QFCAT}{?=?} &
-\cross{QFCAT}{?\^{}?} \\
-\cross{QFCAT}{?quo?} &
-\cross{QFCAT}{?rem?} &
-\cross{QFCAT}{?\~{}=?} \\
-\cross{QFCAT}{?$<$?} &
-\cross{QFCAT}{?$<=$?} &
-\cross{QFCAT}{?$>$?} \\
-\cross{QFCAT}{?$>=$?} &&
-\end{tabular}
-
-{\bf Attributes Exported:}
-\begin{itemize}
-\item {\bf \cross{QFCAT}{canonicalUnitNormal}}
-is true if we can choose a canonical representative for each class 
-of associate elements, that is {\tt associates?(a,b)} returns true 
-if and only if {\tt unitCanonical(a) = unitCanonical(b)}.
-\item {\bf \cross{QFCAT}{canonicalsClosed}}
-is true if\hfill\\
-{\tt unitCanonical(a)*unitCanonical(b) = unitCanonical(a*b)}.
-\item {\bf \cross{QFCAT}{noZeroDivisors}}
-is true if $x * y \ne 0$ implies both x and y are non-zero.
-\item {\bf \cross{QFCAT}{commutative(``*'')}}
-is true if it has an operation $"*": (D,D) -> D$
-which is commutative.
-\item {\bf \cross{QFCAT}{unitsKnown}}
-is true if a monoid (a multiplicative semigroup with a 1) has 
-unitsKnown means that  the operation {\tt recip} can only return 
-``failed'' if its argument is not a unit.
-\item {\bf \cross{QFCAT}{leftUnitary}}
-is true if $1 * x = x$ for all x.
-\item {\bf \cross{QFCAT}{rightUnitary}}
-is true if $x * 1 = x$ for all x.
-\item {\bf nil}
-\end{itemize}
+\begin{tabular}{llll}
+\cross{INFCLCT}{?=?} &
+\cross{INFCLCT}{?\~{}=?} &
+\cross{INFCLCT}{actualExtensionV} &
+\cross{INFCLCT}{chartV} \\
+\cross{INFCLCT}{coerce} &
+\cross{INFCLCT}{create} &
+\cross{INFCLCT}{curveV} &
+\cross{INFCLCT}{degree} \\
+\cross{INFCLCT}{excpDivV} &
+\cross{INFCLCT}{hash} &
+\cross{INFCLCT}{latex} &
+\cross{INFCLCT}{localParamV} \\
+\cross{INFCLCT}{localPointV} &
+\cross{INFCLCT}{multV} &
+\cross{INFCLCT}{pointV} &
+\cross{INFCLCT}{setchart!} \\
+\cross{INFCLCT}{setcurve!} &
+\cross{INFCLCT}{setexcpDiv!} &
+\cross{INFCLCT}{setlocalParam!} &
+\cross{INFCLCT}{setlocalPoint!} \\
+\cross{INFCLCT}{setmult!} &
+\cross{INFCLCT}{setpoint!} &
+\cross{INFCLCT}{setsubmult!} &
+\cross{INFCLCT}{setsymbName!} \\
+\cross{INFCLCT}{subMultV} &
+\cross{INFCLCT}{symbNameV} &&
+\end{tabular} 
 
 These are directly exported but not implemented:
 \begin{verbatim}
- ceiling : % -> S if S has INS        
- denom : % -> S                       
- floor : % -> S if S has INS
- numer : % -> S
- wholePart : % -> S if S has EUCDOM
- ?/? : (S,S) -> %                     
-\end{verbatim}
-
-These are implemented by this category:
-\begin{verbatim}
- characteristic : () -> NonNegativeInteger
- coerce : Symbol -> % if S has RETRACT SYMBOL
- coerce : Fraction Integer -> %       
- convert : % -> InputForm if S has KONVERT INFORM
- convert : % -> DoubleFloat if S has REAL
- convert : % -> Float if S has REAL
- convert : % -> Pattern Integer if S has KONVERT PATTERN INT
- convert : % -> Pattern Float if S has KONVERT PATTERN FLOAT
- denominator : % -> %
- differentiate : (%,(S -> S)) -> %
- fractionPart : % -> % if S has EUCDOM
- init : () -> % if S has STEP
- map : ((S -> S),%) -> %              
- nextItem : % -> Union(%,"failed") if S has STEP
- numerator : % -> %                   
- patternMatch :
-   (%,Pattern Float,PatternMatchResult(Float,%)) ->
-     PatternMatchResult(Float,%) 
-      if S has PATMAB FLOAT
- patternMatch : 
-   (%,Pattern Integer,PatternMatchResult(Integer,%)) ->
-     PatternMatchResult(Integer,%) 
-       if S has PATMAB INT
- random : () -> % if S has INS        
- reducedSystem : Matrix % -> Matrix S
- reducedSystem : (Matrix %,Vector %) -> Record(mat: Matrix S,vec: Vector S)
- retract : % -> Symbol if S has RETRACT SYMBOL
- retract : % -> Integer if S has RETRACT INT
- retractIfCan : % -> Union(Integer,"failed") if S has RETRACT INT
- retractIfCan : % -> Union(Symbol,"failed") if S has RETRACT SYMBOL
- ?<? : (%,%) -> Boolean if S has ORDSET
+ actualExtensionV : % -> K
+ chartV : % -> BLMET                  
+ create :
+  (ProjPt,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),
+   AffinePlane K,NonNegativeInteger,BLMET,NonNegativeInteger,DIVISOR,K,Symbol)
+     -> %
+ create : (ProjPt,PolyRing) -> %      
+ curveV : % -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
+ excpDivV : % -> DIVISOR              
+ localParamV : % -> List PCS
+ localPointV : % -> AffinePlane K     
+ multV : % -> NonNegativeInteger
+ pointV : % -> ProjPt                 
+ setchart! : (%,BLMET) -> BLMET
+ setcurve! :
+   (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> 
+     DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
+ setexcpDiv! : (%,DIVISOR) -> DIVISOR
+ setlocalParam! : (%,List PCS) -> List PCS
+ setlocalPoint! : (%,AffinePlane K) -> AffinePlane K
+ setmult! : (%,NonNegativeInteger) -> NonNegativeInteger
+ setpoint! : (%,ProjPt) -> ProjPt     
+ setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger
+ setsymbName! : (%,Symbol) -> Symbol
+ subMultV : % -> NonNegativeInteger
+ symbNameV : % -> Symbol
 \end{verbatim}
 
-These exports come from \refto{Field}():
+These exports come from \refto{SetCategoryWithDegree}:
 \begin{verbatim}
- 0 : () -> %                          
- 1 : () -> %
- associates? : (%,%) -> Boolean
- coerce : % -> %
- coerce : Integer -> %                
- coerce : % -> OutputForm
- divide : (%,%) -> Record(quotient: %,remainder: %)
- euclideanSize : % -> NonNegativeInteger
- expressIdealMember : (List %,%) -> Union(List %,"failed")
- extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
- extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
- exquo : (%,%) -> Union(%,"failed")
- factor : % -> Factored %             
- gcd : (%,%) -> %
- gcd : List % -> %                    
- gcdPolynomial : 
-   (SparseUnivariatePolynomial %,
-    SparseUnivariatePolynomial %) ->
-      SparseUnivariatePolynomial %
- hash : % -> SingleInteger            
- inv : % -> %                         
- latex : % -> String
- lcm : List % -> %                    
- lcm : (%,%) -> %
- multiEuclidean : (List %,%) -> Union(List %,"failed")
- one? : % -> Boolean
- prime? : % -> Boolean                
- principalIdeal : List % -> Record(coef: List %,generator: %)
- recip : % -> Union(%,"failed")
- sample : () -> %                     
- sizeLess? : (%,%) -> Boolean
- squareFree : % -> Factored %         
- squareFreePart : % -> %
- subtractIfCan : (%,%) -> Union(%,"failed")
- unit? : % -> Boolean                 
- unitCanonical : % -> %
- unitNormal : % -> Record(unit: %,canonical: %,associate: %)
- zero? : % -> Boolean                 
- ?*? : (Fraction Integer,%) -> %      
- ?*? : (%,Fraction Integer) -> %
- ?**? : (%,Integer) -> %
- ?^? : (%,Integer) -> %
- ?+? : (%,%) -> %
  ?=? : (%,%) -> Boolean               
  ?~=? : (%,%) -> Boolean
- ?*? : (%,%) -> %                     
- ?*? : (Integer,%) -> %
- ?*? : (PositiveInteger,%) -> %       
- ?*? : (NonNegativeInteger,%) -> %
- ?-? : (%,%) -> %                     
- -? : % -> %
- ?**? : (%,PositiveInteger) -> %      
- ?**? : (%,NonNegativeInteger) -> %
- ?^? : (%,NonNegativeInteger) -> %
- ?^? : (%,PositiveInteger) -> %       
- ?/? : (%,%) -> %
- ?quo? : (%,%) -> %
- ?rem? : (%,%) -> %                   
+ coerce : % -> OutputForm
+ degree : % -> PositiveInteger        
+ hash : % -> SingleInteger
+ latex : % -> String                  
 \end{verbatim}
 
-These exports come from \refto{Algebra}(S:IntegralDomain):
-\begin{verbatim}
- coerce : S -> %
- ?*? : (%,S) -> %                     
- ?*? : (S,%) -> %
-\end{verbatim}
+\begin{chunk}{category INFCLCT InfinitlyClosePointCategory}
+)abbrev category INFCLCT InfinitlyClosePointCategory
+++ Authors: Gaetan Hache
+++ Date Created: may 1997 
+++ Date Last Updated: April 2010, by Tim Daly
+++ Description: 
+++ This category is part of the PAFF package
+InfinitlyClosePointCategory(_
+     K        :Field,_
+     symb     :List(Symbol),_
+     PolyRing :PolynomialCategory(K,E,OrderedVariableList(symb)),_
+     E        :DirectProductCategory(#symb,NonNegativeInteger),_
+     ProjPt   :ProjectiveSpaceCategory(K),_
+     PCS      :LocalPowerSeriesCategory(K),_
+     Plc      :PlacesCategory(K,PCS),_
+     DIVISOR  :DivisorCategory(Plc),_
+     BLMET    :BlowUpMethodCategory_
+       ):Category == Exports where
 
-These exports come from \refto{RetractableTo}(S:IntegralDomain):
-\begin{verbatim}
- retract : % -> S
- retractIfCan : % -> Union(S,"failed")
-\end{verbatim}
+ bls      ==> ['X,'Y]
+ BlUpRing ==> DistributedMultivariatePolynomial(bls , K)
+ AFP      ==> AffinePlane(K)
 
-These exports come from \refto{FullyEvalableOver}(S:IntegralDomain):
-\begin{verbatim}
- ?.? : (%,S) -> % if S has ELTAB(S,S)
- eval : (%,Equation S) -> % if S has EVALAB S
- eval : (%,List Symbol,List S) -> % if S has IEVALAB(SYMBOL,S)
- eval : (%,List Equation S) -> % if S has EVALAB S
- eval : (%,S,S) -> % if S has EVALAB S
- eval : (%,List S,List S) -> % if S has EVALAB S
- eval : (%,Symbol,S) -> % if S has IEVALAB(SYMBOL,S)
-\end{verbatim}
+ Exports ==> SetCategoryWithDegree with
 
-These exports come from \refto{DifferentialExtension}(S:IntegralDomain):
-\begin{verbatim}
- D : (%,(S -> S)) -> %
- D : (%,(S -> S),NonNegativeInteger) -> %
- D : % -> % if S has DIFRING          
- D : (%,NonNegativeInteger) -> % if S has DIFRING
- D : (%,List Symbol,List NonNegativeInteger) -> % 
-     if S has PDRING SYMBOL
- D : (%,Symbol,NonNegativeInteger) -> % 
-     if S has PDRING SYMBOL
- D : (%,List Symbol) -> % if S has PDRING SYMBOL
- D : (%,Symbol) -> % if S has PDRING SYMBOL
- differentiate : (%,List Symbol) -> % 
-     if S has PDRING SYMBOL
- differentiate : (%,Symbol,NonNegativeInteger) -> % 
-     if S has PDRING SYMBOL
- differentiate : (%,List Symbol,List NonNegativeInteger) -> % 
-     if S has PDRING SYMBOL
- differentiate : (%,NonNegativeInteger) -> % if S has DIFRING
- differentiate : % -> % if S has DIFRING
- differentiate : (%,Symbol) -> % if S has PDRING SYMBOL
- differentiate : (%,(S -> S),NonNegativeInteger) -> %
-\end{verbatim}
+    create:  (ProjPt ,  BlUpRing, AFP , NonNegativeInteger,BLMET, _
+              NonNegativeInteger,  DIVISOR,K,Symbol) -> %  
+      ++ create an infinitly close point
 
-These exports come from 
-\refto{FullyLinearlyExplicitRingOver}(S:IntegralDomain):
-\begin{verbatim}
- reducedSystem : (Matrix %,Vector %) ->
-   Record(mat: Matrix Integer,vec: Vector Integer) 
-     if S has LINEXP INT
- reducedSystem : Matrix % -> Matrix Integer if S has LINEXP INT
-\end{verbatim}
+    create:  (ProjPt,PolyRing) -> %
+      
+    setpoint_!:  (%,ProjPt) -> ProjPt
 
-These exports come from \refto{RetractableTo}(Fraction(Integer)):
-\begin{verbatim}
- retract : % -> Fraction Integer if S has RETRACT INT
- retractIfCan : % -> Union(Fraction Integer,"failed") 
-   if S has RETRACT INT
-\end{verbatim}
+    setcurve_!:  (%,BlUpRing) -> BlUpRing
 
-These exports come from \refto{OrderedSet}():
-\begin{verbatim}
- max : (%,%) -> % if S has ORDSET
- min : (%,%) -> % if S has ORDSET
- ?<=? : (%,%) -> Boolean if S has ORDSET
- ?>? : (%,%) -> Boolean if S has ORDSET
- ?>=? : (%,%) -> Boolean if S has ORDSET
-\end{verbatim}
+    setlocalPoint_!:   (%,AFP) -> AFP
+ 
+    setsubmult_! : (%, NonNegativeInteger) -> NonNegativeInteger
 
-These exports come from \refto{OrderedIntegralDomain}():
-\begin{verbatim}
- abs : % -> % if S has OINTDOM
- negative? : % -> Boolean if S has OINTDOM
- positive? : % -> Boolean if S has OINTDOM
- sign : % -> Integer if S has OINTDOM
-\end{verbatim}
+    setmult_!:    (%,NonNegativeInteger) -> NonNegativeInteger
+ 
+    setchart_!:   (%,BLMET) -> BLMET -- CHH
 
-These exports come from \refto{CharacteristicNonZero}():
-\begin{verbatim}
- charthRoot : % -> Union(%,"failed") 
-   if S has CHARNZ 
-   or and(has($,CharacteristicNonZero),
-          has(S,PolynomialFactorizationExplicit))
-\end{verbatim}
+    setexcpDiv_!: (%,DIVISOR) -> DIVISOR
 
-These exports come from \refto{PolynomialFactorizationExplicit}():
-\begin{verbatim}
- conditionP : Matrix % -> Union(Vector %,"failed") 
-   if and(has($,CharacteristicNonZero),
-          has(S,PolynomialFactorizationExplicit))
- factorPolynomial : 
-   SparseUnivariatePolynomial % -> 
-     Factored SparseUnivariatePolynomial % 
-       if S has PFECAT
- factorSquareFreePolynomial : 
-   SparseUnivariatePolynomial % -> 
-     Factored SparseUnivariatePolynomial % 
-       if S has PFECAT
- solveLinearPolynomialEquation : 
-   (List SparseUnivariatePolynomial %,
-    SparseUnivariatePolynomial %) -> 
-      Union(List SparseUnivariatePolynomial %,"failed") 
-       if S has PFECAT
- squareFreePolynomial : 
-   SparseUnivariatePolynomial % -> 
-     Factored SparseUnivariatePolynomial % 
-       if S has PFECAT
-\end{verbatim}
+    setlocalParam_!: (%,List PCS) -> List(PCS)
 
-\begin{chunk}{category QFCAT QuotientFieldCategory}
-)abbrev category QFCAT QuotientFieldCategory
-++ Date Last Updated: 5th March 1996 
-++ Description:
-++ QuotientField(S) is the category of fractions of an Integral Domain S.
+    setsymbName_!: (%,Symbol) -> Symbol
+ 
+    subMultV: % -> NonNegativeInteger
 
-QuotientFieldCategory(S: IntegralDomain): Category ==
-  Join(Field, Algebra S, RetractableTo S, FullyEvalableOver S,
-         DifferentialExtension S, FullyLinearlyExplicitRingOver S,
-           Patternable S, FullyPatternMatchable S) with
-    _/     : (S, S) -> %
-       ++ d1 / d2 returns the fraction d1 divided by d2.
-    numer  : % -> S
-       ++ numer(x) returns the numerator of the fraction x.
-    denom  : % -> S
-       ++ denom(x) returns the denominator of the fraction x.
-    numerator : % -> %
-       ++ numerator(x) is the numerator of the fraction x converted to %.
-    denominator : % -> %
-       ++ denominator(x) is the denominator of the fraction x converted to %.
-    if S has StepThrough then StepThrough
-    if S has RetractableTo Integer then
-             RetractableTo Integer
-             RetractableTo Fraction Integer
-    if S has OrderedSet then OrderedSet
-    if S has OrderedIntegralDomain then OrderedIntegralDomain
-    if S has RealConstant then RealConstant
-    if S has ConvertibleTo InputForm then ConvertibleTo InputForm
-    if S has CharacteristicZero then CharacteristicZero
-    if S has CharacteristicNonZero then CharacteristicNonZero
-    if S has RetractableTo Symbol then RetractableTo Symbol
-    if S has EuclideanDomain then
-      wholePart: % -> S
-        ++ wholePart(x) returns the whole part of the fraction x
-        ++ i.e. the truncated quotient of the numerator by the denominator.
-      fractionPart: % -> %
-        ++ fractionPart(x) returns the fractional part of x.
-        ++ x = wholePart(x) + fractionPart(x)
-    if S has IntegerNumberSystem then
-      random: () -> %
-        ++ random() returns a random fraction.
-      ceiling : % -> S
-        ++ ceiling(x) returns the smallest integral element above x.
-      floor: % -> S
-        ++ floor(x) returns the largest integral element below x.
-    if S has PolynomialFactorizationExplicit then
-      PolynomialFactorizationExplicit
+    localParamV: % -> List PCS
 
- add
-    import MatrixCommonDenominator(S, %)
+    symbNameV: % -> Symbol
 
-    numerator(x) == numer(x)::%
+    pointV:  % -> ProjPt
+      ++ pointV returns the infinitly close point.
 
-    denominator(x) == denom(x) ::%
+    curveV:  % -> BlUpRing
+      ++ curveV(p) returns the defining polynomial of the strict transform 
+      ++ on which lies the corresponding infinitly close point.
 
-    if S has StepThrough then
-       init() == init()$S / 1$S
+    localPointV: % -> AFP
+      ++ localPointV returns the coordinates of the local infinitly 
+      ++ close point
 
-       nextItem(n) ==
-         m:= nextItem(numer(n))
-         m case "failed" =>
-           error "We seem to have a Fraction of a finite object"
-         m / 1
+    multV:       % -> NonNegativeInteger
+      ++ multV returns the multiplicity of the infinitly close point.
 
-    map(fn, x)                         == (fn numer x) / (fn denom x)
+    chartV:      % -> BLMET -- CHH
+      ++ chartV is the chart of the infinitly close point. The first integer 
+      ++ correspond to variable defining the exceptional line, the last one 
+      ++ the affine  neighboorhood and the second one is the 
+      ++ remaining integer. For example [1,2,3] means that
+      ++ Z=1, X=X and Y=XY. [2,3,1] means that X=1, Y=Y and Z=YZ.     
 
-    reducedSystem(m:Matrix %):Matrix S == clearDenominator m
+    excpDivV:    % -> DIVISOR
+      ++ excpDivV returns the exceptional divisor of the infinitly close point.
 
-    characteristic()                   == characteristic()$S
+    actualExtensionV: % -> K
 
-    differentiate(x:%, deriv:S -> S) ==
-        n := numer x
-        d := denom x
-        (deriv n * d - n * deriv d) / (d**2)
+\end{chunk}
 
-    if S has ConvertibleTo InputForm then
-      convert(x:%):InputForm == (convert numer x) / (convert denom x)
+\begin{chunk}{INFCLCT.dotabb}
+"INFCLCT" [color=lightblue,href="bookvol10.2.pdf#nameddest=INFCLCT"];
+"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
+"INFCLCT" -> "ALIST"
 
-    if S has RealConstant then
-      convert(x:%):Float == (convert numer x) / (convert denom x)
+\end{chunk}
 
-      convert(x:%):DoubleFloat == (convert numer x) / (convert denom x)
+\begin{chunk}{INFCLCT.dotfull}
+"InfinitlyClosePointCategory"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=INFCLCT"];
+"InfinitlyClosePointCategory" -> "AssocationList(SetCategory,SetCategory)"
 
-    -- Note that being a Join(OrderedSet,IntegralDomain) is not the same 
-    -- as being an OrderedIntegralDomain.
-    if S has OrderedIntegralDomain then
-       if S has canonicalUnitNormal then
-           x:% < y:% ==
-             (numer x  * denom y) < (numer y * denom x)
-         else
-           x:% < y:% ==
-             if denom(x) < 0 then (x,y):=(y,x)
-             if denom(y) < 0 then (x,y):=(y,x)
-             (numer x  * denom y) < (numer y * denom x)
-    else if S has OrderedSet then
-       x:% < y:% ==
-         (numer x  * denom y) < (numer y * denom x)
+\end{chunk}
 
-    if (S has EuclideanDomain) then
-      fractionPart x == x - (wholePart(x)::%)
+\begin{chunk}{INFCLCT.dotpic}
+digraph pic {
+ fontsize=10;
+ bgcolor="#ECEA81";
+ node [shape=box, color=white, style=filled];
 
-    if S has RetractableTo Symbol then
-      coerce(s:Symbol):%  == s::S::%
+"InfinitlyClosePointCategory" [color=lightblue];
+"InfinitlyClosePointCategory" -> "AssocationList(SetCategory,SetCategory)"
 
-      retract(x:%):Symbol == retract(retract(x)@S)
+"AssocationList(SetCategory,SetCategory)" -> "AssocationList()"
 
-      retractIfCan(x:%):Union(Symbol, "failed") ==
-        (r := retractIfCan(x)@Union(S,"failed")) case "failed" =>"failed"
-        retractIfCan(r::S)
+"AssocationList()" [color=lightblue];
 
-    if (S has ConvertibleTo Pattern Integer) then
-      convert(x:%):Pattern(Integer)==(convert numer x)/(convert denom x)
-
-      if (S has PatternMatchable Integer) then
-        patternMatch(x:%, p:Pattern Integer,
-         l:PatternMatchResult(Integer, %)) ==
-           patternMatch(x, p,
-                     l)$PatternMatchQuotientFieldCategory(Integer, S, %)
-
-    if (S has ConvertibleTo Pattern Float) then
-      convert(x:%):Pattern(Float) == (convert numer x)/(convert denom x)
-
-      if (S has PatternMatchable Float) then
-        patternMatch(x:%, p:Pattern Float,
-         l:PatternMatchResult(Float, %)) ==
-           patternMatch(x, p,
-                       l)$PatternMatchQuotientFieldCategory(Float, S, %)
-
-    if S has RetractableTo Integer then
-      coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::%
-
-      if not(S is Integer) then
-        retract(x:%):Integer == retract(retract(x)@S)
-
-        retractIfCan(x:%):Union(Integer, "failed") ==
-          (u := retractIfCan(x)@Union(S, "failed")) case "failed" =>
-            "failed"
-          retractIfCan(u::S)
-
-    if S has IntegerNumberSystem then
-      random():% ==
-        while zero?(d:=random()$S) repeat d
-        random()$S / d
-
-    reducedSystem(m:Matrix %, v:Vector %):
-      Record(mat:Matrix S, vec:Vector S) ==
-        n := reducedSystem(horizConcat(v::Matrix(%), m))@Matrix(S)
-        [subMatrix(n, minRowIndex n, maxRowIndex n, 1 + minColIndex n,
-                                maxColIndex n), column(n, minColIndex n)]
-
-\end{chunk}
-\begin{chunk}{QFCAT.dotabb}
-"QFCAT"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=QFCAT"];
-"QFCAT" -> "ALGEBRA"
-"QFCAT" -> "DIFEXT"
-"QFCAT" -> "FIELD"
-"QFCAT" -> "FEVALAB"
-"QFCAT" -> "FLINEXP"
-"QFCAT" -> "FPATMAB"
-"QFCAT" -> "PATAB"
-"QFCAT" -> "RETRACT"
-
-\end{chunk}
-\begin{chunk}{QFCAT.dotfull}
-"QuotientFieldCategory(a:IntegralDomain)"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=QFCAT"];
-"QuotientFieldCategory(a:IntegralDomain)" -> "Field()"
-"QuotientFieldCategory(a:IntegralDomain)" -> "Algebra(IntegralDomain)"
-"QuotientFieldCategory(a:IntegralDomain)" -> "RetractableTo(IntegralDomain)"
-"QuotientFieldCategory(a:IntegralDomain)" -> 
-  "FullyEvalableOver(IntegralDomain)"
-"QuotientFieldCategory(a:IntegralDomain)" ->
-  "DifferentialExtension(IntegralDomain)"
-"QuotientFieldCategory(a:IntegralDomain)" ->
-  "FullyLinearlyExplicitRingOver(IntegralDomain)"
-"QuotientFieldCategory(a:IntegralDomain)" ->
-  "Patternable(IntegralDomain)"
-"QuotientFieldCategory(a:IntegralDomain)" ->
-  "FullyPatternMatchable(IntegralDomain)"
-
-\end{chunk}
-\begin{chunk}{QFCAT.dotpic}
-digraph pic {
- fontsize=10;
- bgcolor="#ECEA81";
- node [shape=box, color=white, style=filled];
-
-"QuotientFieldCategory(a:IntegralDomain)" [color=lightblue];
-"QuotientFieldCategory(a:IntegralDomain)" -> "ALGEBRA..."
-"QuotientFieldCategory(a:IntegralDomain)" -> "DIFEXT..."
-"QuotientFieldCategory(a:IntegralDomain)" -> "FIELD..."
-"QuotientFieldCategory(a:IntegralDomain)" -> "FEVALAB..."
-"QuotientFieldCategory(a:IntegralDomain)" -> "FLINEXP..."
-"QuotientFieldCategory(a:IntegralDomain)" -> "FPATMAB..."
-"QuotientFieldCategory(a:IntegralDomain)" -> "PATAB..."
-"QuotientFieldCategory(a:IntegralDomain)" -> "RETRACT..."
-
-"ALGEBRA..." [color=lightblue];
-"DIFEXT..." [color=lightblue];
-"FIELD..." [color=lightblue];
-"FEVALAB..." [color=lightblue];
-"FLINEXP..." [color=lightblue];
-"FPATMAB..." [color=lightblue];
-"PATAB..." [color=lightblue];
-"RETRACT..." [color=lightblue];
-
-}
+}
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\pagehead{RealClosedField}{RCFIELD}
-\pagepic{ps/v102realclosedfield.ps}{RCFIELD}{0.50}
+\pagehead{PseudoAlgebraicClosureOfPerfectFieldCategory}{PACPERC}
+\pagepic{ps/v102pseudoalgebraicclosureofperfectfieldcategory.ps}{PACPERC}{0.50}
 
-\begin{chunk}{RealClosedField.input}
+\begin{chunk}{PseudoAlgebraicClosureOfPerfectFieldCategory.input}
 )set break resume
-)sys rm -f RealClosedField.output
-)spool RealClosedField.output
+)sys rm -f PseudoAlgebraicClosureOfPerfectFieldCategory.output
+)spool PseudoAlgebraicClosureOfPerfectFieldCategory.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show RealClosedField
+)show PseudoAlgebraicClosureOfPerfectFieldCategory
 --R 
---R RealClosedField  is a category constructor
---R Abbreviation for RealClosedField is RCFIELD 
+--R PseudoAlgebraicClosureOfPerfectFieldCategory  is a category constructor
+--R Abbreviation for PseudoAlgebraicClosureOfPerfectFieldCategory is PACPERC 
 --R This constructor is exposed in this frame.
---R Issue )edit bookvol10.2.pamphlet to see algebra source code for RCFIELD 
+--R Issue )edit bookvol10.2.pamphlet to see algebra source code for PACPERC 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (%,Fraction(Integer)) -> %      ?*? : (Fraction(Integer),%) -> %
---R ?*? : (%,Integer) -> %                ?*? : (Integer,%) -> %
---R ?*? : (%,Fraction(Integer)) -> %      ?*? : (Fraction(Integer),%) -> %
+--R ?*? : (Fraction(Integer),%) -> %      ?*? : (%,Fraction(Integer)) -> %
 --R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
 --R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,Fraction(Integer)) -> %     ?**? : (%,Integer) -> %
---R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
---R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
---R -? : % -> %                           ?/? : (%,%) -> %
---R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
---R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
---R ?>=? : (%,%) -> Boolean               1 : () -> %
---R 0 : () -> %                           ?^? : (%,Integer) -> %
---R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R abs : % -> %                          associates? : (%,%) -> Boolean
---R coerce : Fraction(Integer) -> %       coerce : Integer -> %
+--R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
+--R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?/? : (%,%) -> %                      ?=? : (%,%) -> Boolean
+--R 1 : () -> %                           0 : () -> %
+--R ?^? : (%,Integer) -> %                ?^? : (%,NonNegativeInteger) -> %
+--R ?^? : (%,PositiveInteger) -> %        associates? : (%,%) -> Boolean
 --R coerce : Fraction(Integer) -> %       coerce : % -> %
---R coerce : Fraction(Integer) -> %       coerce : Integer -> %
---R coerce : % -> OutputForm              factor : % -> Factored(%)
---R gcd : (%,%) -> %                      gcd : List(%) -> %
---R hash : % -> SingleInteger             inv : % -> %
---R latex : % -> String                   lcm : (%,%) -> %
---R lcm : List(%) -> %                    max : (%,%) -> %
---R min : (%,%) -> %                      negative? : % -> Boolean
---R nthRoot : (%,Integer) -> %            one? : % -> Boolean
---R positive? : % -> Boolean              prime? : % -> Boolean
+--R coerce : Integer -> %                 coerce : % -> OutputForm
+--R conjugate : % -> %                    extDegree : % -> PositiveInteger
+--R factor : % -> Factored(%)             fullOutput : % -> OutputForm
+--R gcd : List(%) -> %                    gcd : (%,%) -> %
+--R ground? : % -> Boolean                hash : % -> SingleInteger
+--R inv : % -> %                          latex : % -> String
+--R lcm : List(%) -> %                    lcm : (%,%) -> %
+--R maxTower : List(%) -> %               one? : % -> Boolean
+--R previousTower : % -> %                prime? : % -> Boolean
 --R ?quo? : (%,%) -> %                    recip : % -> Union(%,"failed")
---R ?rem? : (%,%) -> %                    rename : (%,OutputForm) -> %
---R rename! : (%,OutputForm) -> %         retract : % -> Fraction(Integer)
---R sample : () -> %                      sign : % -> Integer
---R sizeLess? : (%,%) -> Boolean          sqrt : Integer -> %
---R sqrt : Fraction(Integer) -> %         sqrt : (%,NonNegativeInteger) -> %
---R sqrt : % -> %                         squareFree : % -> Factored(%)
---R squareFreePart : % -> %               unit? : % -> Boolean
---R unitCanonical : % -> %                zero? : % -> Boolean
+--R ?rem? : (%,%) -> %                    sample : () -> %
+--R setTower! : % -> Void                 sizeLess? : (%,%) -> Boolean
+--R squareFree : % -> Factored(%)         squareFreePart : % -> %
+--R unit? : % -> Boolean                  unitCanonical : % -> %
+--R vectorise : (%,%) -> Vector(%)        zero? : % -> Boolean
 --R ?~=? : (%,%) -> Boolean              
---R allRootsOf : Polynomial(Integer) -> List(%)
---R allRootsOf : Polynomial(Fraction(Integer)) -> List(%)
---R allRootsOf : Polynomial(%) -> List(%)
---R allRootsOf : SparseUnivariatePolynomial(Integer) -> List(%)
---R allRootsOf : SparseUnivariatePolynomial(Fraction(Integer)) -> List(%)
---R allRootsOf : SparseUnivariatePolynomial(%) -> List(%)
---R approximate : (%,%) -> Fraction(Integer)
 --R characteristic : () -> NonNegativeInteger
+--R definingPolynomial : % -> SparseUnivariatePolynomial(%)
+--R definingPolynomial : () -> SparseUnivariatePolynomial(%)
+--R distinguishedRootsOf : (SparseUnivariatePolynomial(%),%) -> List(%)
 --R divide : (%,%) -> Record(quotient: %,remainder: %)
 --R euclideanSize : % -> NonNegativeInteger
 --R expressIdealMember : (List(%),%) -> Union(List(%),"failed")
 --R exquo : (%,%) -> Union(%,"failed")
---R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
 --R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
+--R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
 --R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
 --R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
---R mainDefiningPolynomial : % -> Union(SparseUnivariatePolynomial(%),"failed")
---R mainForm : % -> Union(OutputForm,"failed")
---R mainValue : % -> Union(SparseUnivariatePolynomial(%),"failed")
+--R lift : (%,%) -> SparseUnivariatePolynomial(%)
+--R lift : % -> SparseUnivariatePolynomial(%)
 --R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
+--R newElement : (SparseUnivariatePolynomial(%),Symbol) -> %
+--R newElement : (SparseUnivariatePolynomial(%),%,Symbol) -> %
 --R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
---R retract : % -> Fraction(Integer) if Fraction(Integer) has RETRACT(FRAC(INT))
---R retract : % -> Integer if Fraction(Integer) has RETRACT(INT)
---R retractIfCan : % -> Union(Fraction(Integer),"failed")
---R retractIfCan : % -> Union(Fraction(Integer),"failed") if Fraction(Integer) has RETRACT(FRAC(INT))
---R retractIfCan : % -> Union(Integer,"failed") if Fraction(Integer) has RETRACT(INT)
---R rootOf : (SparseUnivariatePolynomial(%),PositiveInteger) -> Union(%,"failed")
---R rootOf : (SparseUnivariatePolynomial(%),PositiveInteger,OutputForm) -> Union(%,"failed")
+--R reduce : SparseUnivariatePolynomial(%) -> %
 --R subtractIfCan : (%,%) -> Union(%,"failed")
 --R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
 --R
@@ -64747,533 +73108,431 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{RealClosedField.help}
+
+\begin{chunk}{PseudoAlgebraicClosureOfPerfectFieldCategory.help}
 ====================================================================
-RealClosedField examples
+PseudoAlgebraicClosureOfPerfectFieldCategory examples
 ====================================================================
 
-RealClosedField provides common access functions for all real closed fields.
-It provides computations with generic real roots of polynomials.
+This category exports the function for domains which implement dynamic 
+extension using the simple notion of tower extensions. A tower extension 
+T of the ground field K is any sequence of field extensions
+    (T : K_0, K_1, ..., K_i...,K_n) where K_0 = K 
+and for 
+    i =1,2,...,n, K_i is an extension of K_{i-1} of degree > 1 
+and defined by an irreducible polynomial p(Z) in K_{i-1}.
+
+Two towers 
+    (T_1: K_01, K_11,...,K_i1,...,K_n1)  
+and 
+    (T_2: K_02, K_12,...,K_i2,...,K_n2)
+are said to be related if 
+    T_1 <= T_2 (or T_1 >= T_2), 
+that is if 
+    K_i1 = K_i2 for i=1,2,...,n1 (or i=1,2,...,n2). 
+
+Any algebraic operations defined for several elements are only defined 
+if all of the concerned elements are coming from a set of related tower 
+extensions. 
 
 See Also:
-o )show RealClosedField
+o )show PseudoAlgebraicClosureOfPerfectFieldCategory
 
 \end{chunk}
-{\bf See:}
 
-\pagefrom{Algebra}{ALGEBRA}
-\pagefrom{CharacteristicZero}{CHARZ}
-\pagefrom{CommutativeRing}{COMRING}
 \pagefrom{Field}{FIELD}
-\pagefrom{FullyRetractableTo}{FRETRCT}
-\pagefrom{OrderedRing}{ORDRING}
-\pagefrom{RadicalCategory}{RADCAT}
 
 {\bf Exports:}\\
-
 \begin{tabular}{llll}
-\cross{RCFIELD}{0} &
-\cross{RCFIELD}{1} &
-\cross{RCFIELD}{abs} &
-\cross{RCFIELD}{allRootsOf} \\
-\cross{RCFIELD}{approximate} &
-\cross{RCFIELD}{associates?} &
-\cross{RCFIELD}{characteristic} &
-\cross{RCFIELD}{coerce} \\
-\cross{RCFIELD}{divide} &
-\cross{RCFIELD}{euclideanSize} &
-\cross{RCFIELD}{expressIdealMember} &
-\cross{RCFIELD}{exquo} \\
-\cross{RCFIELD}{extendedEuclidean} &
-\cross{RCFIELD}{factor} &
-\cross{RCFIELD}{gcd} &
-\cross{RCFIELD}{gcdPolynomial} \\
-\cross{RCFIELD}{hash} &
-\cross{RCFIELD}{inv} &
-\cross{RCFIELD}{latex} &
-\cross{RCFIELD}{lcm} \\
-\cross{RCFIELD}{mainDefiningPolynomial} &
-\cross{RCFIELD}{mainForm} &
-\cross{RCFIELD}{mainValue} &
-\cross{RCFIELD}{max} \\
-\cross{RCFIELD}{min} &
-\cross{RCFIELD}{multiEuclidean} &
-\cross{RCFIELD}{negative?} &
-\cross{RCFIELD}{nthRoot} \\
-\cross{RCFIELD}{one?} &
-\cross{RCFIELD}{positive?} &
-\cross{RCFIELD}{prime?} &
-\cross{RCFIELD}{principalIdeal} \\
-\cross{RCFIELD}{recip} &
-\cross{RCFIELD}{rename} &
-\cross{RCFIELD}{rename!} &
-\cross{RCFIELD}{retract} \\
-\cross{RCFIELD}{retractIfCan} &
-\cross{RCFIELD}{rootOf} &
-\cross{RCFIELD}{sample} &
-\cross{RCFIELD}{sign} \\
-\cross{RCFIELD}{sizeLess?} &
-\cross{RCFIELD}{sqrt} &
-\cross{RCFIELD}{squareFree} &
-\cross{RCFIELD}{squareFreePart} \\
-\cross{RCFIELD}{subtractIfCan} &
-\cross{RCFIELD}{unit?} &
-\cross{RCFIELD}{unitCanonical} &
-\cross{RCFIELD}{unitNormal} \\
-\cross{RCFIELD}{zero?} &
-\cross{RCFIELD}{?*?} &
-\cross{RCFIELD}{?**?} &
-\cross{RCFIELD}{?+?} \\
-\cross{RCFIELD}{?-?} &
-\cross{RCFIELD}{-?} &
-\cross{RCFIELD}{?/?} &
-\cross{RCFIELD}{?$<$?} \\
-\cross{RCFIELD}{?$<=$?} &
-\cross{RCFIELD}{?=?} &
-\cross{RCFIELD}{?$>$?} &
-\cross{RCFIELD}{?$>=$?} \\
-\cross{RCFIELD}{?\^{}?} &
-\cross{RCFIELD}{?\~{}=?} &
-\cross{RCFIELD}{?quo?} &
-\cross{RCFIELD}{?rem?} \\
-\end{tabular}
+\cross{PACPERC}{0} &
+\cross{PACPERC}{1} &
+\cross{PACPERC}{associates?} &
+\cross{PACPERC}{characteristic} \\
+\cross{PACPERC}{coerce} &
+\cross{PACPERC}{conjugate} &
+\cross{PACPERC}{definingPolynomial} &
+\cross{PACPERC}{distinguishedRootsOf} \\
+\cross{PACPERC}{divide} &
+\cross{PACPERC}{euclideanSize} &
+\cross{PACPERC}{expressIdealMember} &
+\cross{PACPERC}{exquo} \\
+\cross{PACPERC}{extDegree} &
+\cross{PACPERC}{extendedEuclidean} &
+\cross{PACPERC}{factor} &
+\cross{PACPERC}{fullOutput} \\
+\cross{PACPERC}{gcd} &
+\cross{PACPERC}{gcdPolynomial} &
+\cross{PACPERC}{ground?} &
+\cross{PACPERC}{hash} \\
+\cross{PACPERC}{inv} &
+\cross{PACPERC}{latex} &
+\cross{PACPERC}{lcm} &
+\cross{PACPERC}{lift} \\
+\cross{PACPERC}{maxTower} &
+\cross{PACPERC}{multiEuclidean} &
+\cross{PACPERC}{newElement} &
+\cross{PACPERC}{one?} \\
+\cross{PACPERC}{previousTower} &
+\cross{PACPERC}{prime?} &
+\cross{PACPERC}{principalIdeal} &
+\cross{PACPERC}{?quo?} \\
+\cross{PACPERC}{recip} &
+\cross{PACPERC}{reduce} &
+\cross{PACPERC}{?rem?} &
+\cross{PACPERC}{sample} \\
+\cross{PACPERC}{setTower!} &
+\cross{PACPERC}{sizeLess?} &
+\cross{PACPERC}{squareFree} &
+\cross{PACPERC}{squareFreePart} \\
+\cross{PACPERC}{subtractIfCan} &
+\cross{PACPERC}{unit?} &
+\cross{PACPERC}{unitCanonical} &
+\cross{PACPERC}{unitNormal} \\
+\cross{PACPERC}{vectorise} &
+\cross{PACPERC}{zero?} &
+\cross{PACPERC}{?*?} &
+\cross{PACPERC}{?**?} \\
+\cross{PACPERC}{?+?} &
+\cross{PACPERC}{?-?} &
+\cross{PACPERC}{-?} &
+\cross{PACPERC}{?/?} \\
+\cross{PACPERC}{?=?} &
+\cross{PACPERC}{?\^{}?} &
+\cross{PACPERC}{?\~{}=?} &
+\end{tabular} 
 
 {\bf Attributes Exported:}
 \begin{itemize}
-\item {\bf \cross{RCFIELD}{noZeroDivisors}}
-is true if $x * y \ne 0$ implies both x and y are non-zero.
-\item {\bf \cross{RCFIELD}{canonicalUnitNormal}}
+\item {\bf \cross{PACPERC}{canonicalUnitNormal}}
 is true if we can choose a canonical representative for each class 
 of associate elements, that is {\tt associates?(a,b)} returns true 
 if and only if {\tt unitCanonical(a) = unitCanonical(b)}.
-\item {\bf \cross{RCFIELD}{canonicalsClosed}}
+\item {\bf \cross{PACPERC}{canonicalsClosed}}
 is true if\hfill\\
 {\tt unitCanonical(a)*unitCanonical(b) = unitCanonical(a*b)}.
-\item {\bf \cross{RCFIELD}{unitsKnown}}
+\item {\bf \cross{PACPERC}{noZeroDivisors}}
+is true if $x * y \ne 0$ implies both x and y are non-zero.
+\item {\bf \cross{PACPERC}{commutative(``*'')}}
+is true if it has an operation $"*": (D,D) -> D$
+which is commutative.
+\item {\bf \cross{PACPERC}{unitsKnown}}
 is true if a monoid (a multiplicative semigroup with a 1) has 
 unitsKnown means that  the operation {\tt recip} can only return 
 ``failed'' if its argument is not a unit.
-\item {\bf \cross{RCFIELD}{leftUnitary}}
+\item {\bf \cross{PACPERC}{leftUnitary}}
 is true if $1 * x = x$ for all x.
-\item {\bf \cross{RCFIELD}{rightUnitary}}
+\item {\bf \cross{PACPERC}{rightUnitary}}
 is true if $x * 1 = x$ for all x.
-\item {\bf \cross{RCFIELD}{commutative(``*'')}}
-is true if it has an operation $"*": (D,D) -> D$
-which is commutative.
 \end{itemize}
 
 These are directly exported but not implemented:
 \begin{verbatim}
- allRootsOf : SparseUnivariatePolynomial % -> List %
- approximate : (%,%) -> Fraction Integer
- mainDefiningPolynomial :
-    % -> Union(SparseUnivariatePolynomial %,"failed")
- mainForm : % -> Union(OutputForm,"failed")
- mainValue : % -> Union(SparseUnivariatePolynomial %,"failed")
- rename : (%,OutputForm) -> %         
- rename! : (%,OutputForm) -> %
+  conjugate: % -> %
+  definingPolynomial: () -> SUP(%)
+  definingPolynomial: % -> SUP %
+  distinguishedRootsOf: (SparseUnivariatePolynomial %,%) -> List %
+  extDegree: % -> PI
+  fullOutput: % -> OutputForm
+  ground_? : % -> Boolean
+  lift: % -> SUP(%)
+  lift: (%,%) -> SUP(%)
+  maxTower: List % -> %
+  newElement: (SUP(%), %, Symbol) -> %
+  newElement: (SUP(%), Symbol) -> %
+  previousTower: % -> %
+  reduce: SUP(%) -> %
+  setTower_!: % -> Void
+  vectorise: (%,%) -> Vector(%)
 \end{verbatim}
 
-These are implemented by this category:
+These exports come from \refto{Field}():
 \begin{verbatim}
- allRootsOf : Polynomial Integer -> List %
- allRootsOf : Polynomial Fraction Integer -> List %
- allRootsOf : Polynomial % -> List %
- allRootsOf : SparseUnivariatePolynomial Integer -> List %
- allRootsOf : SparseUnivariatePolynomial Fraction Integer -> List %
- characteristic : () -> NonNegativeInteger
- nthRoot : (%,Integer) -> %
- rootOf :
-   (SparseUnivariatePolynomial %,PositiveInteger) ->
-      Union(%,"failed")
- rootOf :
-   (SparseUnivariatePolynomial %,PositiveInteger,OutputForm) ->
-      Union(%,"failed")
- sqrt : (%,NonNegativeInteger) -> %
- sqrt : Integer -> %                  
- sqrt : Fraction Integer -> %
- sqrt : % -> %                        
- ?**? : (%,Fraction Integer) -> %
+ associates? : (%,%) -> Boolean       
+ divide : (%,%) -> Record(quotient: %,remainder: %)
+ euclideanSize : % -> NonNegativeInteger
+ exquo : (%,%) -> Union(%,"failed")
+ factor : % -> Factored %
+ gcd : (%,%) -> %                     
+ inv : % -> %
+ prime? : % -> Boolean
+ squareFree : % -> Factored %
+ unitCanonical : % -> %               
+ unitNormal : % -> Record(unit: %,canonical: %,associate: %)
+ ?/? : (%,%) -> %                     
 \end{verbatim}
 
-These exports come from \refto{CharacteristicZero}():
+These exports come from \refto{EuclideanDomain}():
 \begin{verbatim}
- 0 : () -> %                          
- 1 : () -> %
- coerce : Integer -> %                
- coerce : % -> OutputForm
- hash : % -> SingleInteger
- latex : % -> String
- one? : % -> Boolean                  
- recip : % -> Union(%,"failed")       
- sample : () -> %
+ 0 : () -> %
+ 1 : () -> %                          
+ characteristic : () -> NonNegativeInteger
+ coerce : % -> %                      
+ coerce : Integer -> %
+ coerce : % -> OutputForm             
+ expressIdealMember : (List %,%) -> Union(List %,"failed")
+ extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
+ extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
+ gcd : List % -> %
+ gcdPolynomial : (SparseUnivariatePolynomial %,
+                  SparseUnivariatePolynomial %) ->
+                    SparseUnivariatePolynomial %
+ hash : % -> SingleInteger            
+ latex : % -> String                  
+ lcm : List % -> %
+ lcm : (%,%) -> %                     
+ multiEuclidean : (List %,%) -> Union(List %,"failed")
+ one? : % -> Boolean
+ principalIdeal : List % -> Record(coef: List %,generator: %)
+ recip : % -> Union(%,"failed")
+ sample : () -> %                     
+ sizeLess? : (%,%) -> Boolean         
  subtractIfCan : (%,%) -> Union(%,"failed")
- zero? : % -> Boolean
- ?~=? : (%,%) -> Boolean              
- ?^? : (%,NonNegativeInteger) -> %
- ?^? : (%,PositiveInteger) -> %       
+ unit? : % -> Boolean
+ zero? : % -> Boolean                 
+ ?+? : (%,%) -> %
+ ?=? : (%,%) -> Boolean
+ ?~=? : (%,%) -> Boolean
  ?*? : (%,%) -> %                     
- ?*? : (NonNegativeInteger,%) -> %
  ?*? : (Integer,%) -> %
  ?*? : (PositiveInteger,%) -> %       
- ?**? : (%,PositiveInteger) -> %
+ ?*? : (NonNegativeInteger,%) -> %
+ ?-? : (%,%) -> %                     
+ -? : % -> %
+ ?**? : (%,PositiveInteger) -> %      
  ?**? : (%,NonNegativeInteger) -> %
- ?+? : (%,%) -> %                     
- ?-? : (%,%) -> %
- -? : % -> %                          
- ?=? : (%,%) -> Boolean               
+ ?^? : (%,PositiveInteger) -> %
+ ?^? : (%,NonNegativeInteger) -> %
+ ?quo? : (%,%) -> %                   
+ ?rem? : (%,%) -> %
 \end{verbatim}
 
-These exports come from \refto{OrderedRing}():
+These exports come from \refto{UniqueFactorizationDomain}():
 \begin{verbatim}
- abs : % -> %
- coerce : Integer -> %                
- max : (%,%) -> %                     
- min : (%,%) -> %
- negative? : % -> Boolean             
- positive? : % -> Boolean
- sign : % -> Integer                  
- ?<? : (%,%) -> Boolean               
- ?<=? : (%,%) -> Boolean
- ?>? : (%,%) -> Boolean
- ?>=? : (%,%) -> Boolean              
- ?*? : (Integer,%) -> %
+ squareFreePart : % -> %
 \end{verbatim}
 
-These exports come from \refto{Field}():
+These exports come from \refto{DivisionRing}():
 \begin{verbatim}
- associates? : (%,%) -> Boolean       
- coerce : % -> %                      
  coerce : Fraction Integer -> %
- coerce : Fraction Integer -> %
- coerce : Fraction Integer -> %
- divide : (%,%) -> Record(quotient: %,remainder: %)
- euclideanSize : % -> NonNegativeInteger
- expressIdealMember : (List %,%) -> Union(List %,"failed")
- exquo : (%,%) -> Union(%,"failed")
- extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
- extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
- factor : % -> Factored %             
- gcd : (%,%) -> %
- gcd : List % -> %                    
- gcdPolynomial :
-   (SparseUnivariatePolynomial %,
-    SparseUnivariatePolynomial %) ->
-       SparseUnivariatePolynomial %
- inv : % -> %                         
- lcm : (%,%) -> %                     
- lcm : List % -> %
- multiEuclidean : (List %,%) -> Union(List %,"failed")
- prime? : % -> Boolean                
- principalIdeal : List % -> Record(coef: List %,generator: %)
- sizeLess? : (%,%) -> Boolean
- squareFree : % -> Factored %
- squareFreePart : % -> %              
- unit? : % -> Boolean
- unitCanonical : % -> %               
- unitNormal : % -> Record(unit: %,canonical: %,associate: %)
- ?/? : (%,%) -> %
- ?*? : (Fraction Integer,%) -> %
- ?*? : (Fraction Integer,%) -> %
- ?*? : (%,Fraction Integer) -> %      
- ?*? : (%,Fraction Integer) -> %      
- ?**? : (%,Integer) -> %              
- ?^? : (%,Integer) -> %
- ?quo? : (%,%) -> %
- ?rem? : (%,%) -> %
-\end{verbatim}
-
-These exports come from \refto{FullyRetractableTo}(Fraction(Integer)):
-\begin{verbatim}
- retract : % -> Fraction Integer      
- retract : % -> Fraction Integer 
-   if Fraction Integer has RETRACT FRAC INT
- retract : % -> Integer if Fraction Integer has RETRACT INT
- retractIfCan : % -> Union(Fraction Integer,"failed")
- retractIfCan : % -> Union(Fraction Integer,"failed") 
-   if Fraction Integer has RETRACT FRAC INT
- retractIfCan : % -> Union(Integer,"failed") 
-   if Fraction Integer has RETRACT INT
-\end{verbatim}
-
-These exports come from \refto{Algebra}(Integer):
-\begin{verbatim}
- ?*? : (%,Integer) -> %               
+ ?*? : (Fraction Integer,%) -> %      
+ ?*? : (%,Fraction Integer) -> %
+ ?**? : (%,Integer) -> %
+ ?^? : (%,Integer) -> %               
 \end{verbatim}
 
-\begin{chunk}{category RCFIELD RealClosedField}
-)abbrev category RCFIELD RealClosedField
-++ Author: Renaud Rioboo
-++ Date Created: may 1993
-++ Date Last Updated: January 2004
-++ Description:
-++ \axiomType{RealClosedField} provides common access
-++ functions for all real closed fields.
-++ provides computations with generic real roots of polynomials 
-
-RealClosedField : Category == PUB where
-
-    E ==> OutputForm
-    SUP ==> SparseUnivariatePolynomial
-    OFIELD ==> Join(OrderedRing,Field)
-    PME ==> SUP($)
-    N ==> NonNegativeInteger
-    PI ==> PositiveInteger
-    RN ==> Fraction(Integer)
-    Z  ==> Integer
-    POLY ==> Polynomial
-    PACK ==> SparseUnivariatePolynomialFunctions2
-
-    PUB == Join(CharacteristicZero,
-                OrderedRing,
-                CommutativeRing,
-                Field,
-                FullyRetractableTo(Fraction(Integer)),
-                Algebra Integer,
-                Algebra(Fraction(Integer)),
-                RadicalCategory) with
-
-        mainForm :   $ -> Union(E,"failed")
-             ++ \axiom{mainForm(x)} is the main algebraic quantity name of 
-             ++ \axiom{x}
-
-        mainDefiningPolynomial :   $ -> Union(PME,"failed")
-             ++ \axiom{mainDefiningPolynomial(x)} is the defining 
-             ++ polynomial for the main algebraic quantity of \axiom{x}
-
-        mainValue :   $ -> Union(PME,"failed")
-             ++ \axiom{mainValue(x)} is the expression of \axiom{x} in terms
-             ++ of \axiom{SparseUnivariatePolynomial($)} 
-
-        rootOf:          (PME,PI,E)           -> Union($,"failed")
-             ++ \axiom{rootOf(pol,n,name)} creates the nth root for the order
-             ++ of \axiom{pol} and names it \axiom{name}
-
-        rootOf:          (PME,PI)             -> Union($,"failed")
-             ++ \axiom{rootOf(pol,n)} creates the nth root for the order
-             ++ of \axiom{pol} and gives it unique name
-
-        allRootsOf:       PME                ->  List $
-             ++ \axiom{allRootsOf(pol)} creates all the roots
-             ++ of \axiom{pol} naming each uniquely
-
-        allRootsOf:       (SUP(RN))          ->  List $
-             ++ \axiom{allRootsOf(pol)} creates all the roots
-             ++ of \axiom{pol} naming each uniquely
-
-        allRootsOf:       (SUP(Z))          ->  List $
-             ++ \axiom{allRootsOf(pol)} creates all the roots
-             ++ of \axiom{pol} naming each uniquely
-
-        allRootsOf:       (POLY($))         ->  List $
-             ++ \axiom{allRootsOf(pol)} creates all the roots
-             ++ of \axiom{pol} naming each uniquely
-
-        allRootsOf:       (POLY(RN))        ->  List $
-             ++ \axiom{allRootsOf(pol)} creates all the roots
-             ++ of \axiom{pol} naming each uniquely
-
-        allRootsOf:       (POLY(Z))         ->  List $
-             ++ \axiom{allRootsOf(pol)} creates all the roots
-             ++ of \axiom{pol} naming each uniquely
-
-        sqrt:            ($,N)                ->     $
-             ++ \axiom{sqrt(x,n)} is \axiom{x ** (1/n)}
-
-        sqrt:              $                  ->     $
-             ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)}
-
-        sqrt:             RN                  ->     $
-             ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)}
-
-        sqrt:              Z                  ->     $
-             ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)}
-
-        rename! :        ($,E)                ->     $
-             ++ \axiom{rename!(x,name)} changes the way \axiom{x} is printed
-
-        rename :         ($,E)                ->     $
-             ++ \axiom{rename(x,name)} gives a new number that prints as name
-
-        approximate:       ($,$) -> RN
-              ++ \axiom{approximate(n,p)} gives an approximation of \axiom{n}
-              ++ that has precision \axiom{p}
-
-      add
-
-        sqrt(a:$):$ == sqrt(a,2)
-
-        sqrt(a:RN):$ == sqrt(a::$,2)
-
-        sqrt(a:Z):$ == sqrt(a::$,2)
-
-        characteristic() == 0
-
-        rootOf(pol,n,o) == 
-          r := rootOf(pol,n)
-          r case "failed" => "failed"
-          rename!(r,o)
-
-        rootOf(pol,n) ==
-          liste:List($):= allRootsOf(pol)
-          # liste > n => "failed"
-          liste.n
+\begin{chunk}{category PACPERC PseudoAlgebraicClosureOfPerfectFieldCategory}
+)abbrev category PACPERC PseudoAlgebraicClosureOfPerfectFieldCategory
+++ Authors: Gaetan Hache
+++ Date Created: may 1997 
+++ Date Last Updated: April 2010, by Tim Daly
+++ Description: 
+++ This category exports the function for domains 
+++ which implement dynamic extension using the simple notion of tower 
+++ extensions. ++ A tower extension T  of the ground
+++ field K is any sequence of field extension 
+++ (T : K_0, K_1, ..., K_i...,K_n) where K_0 = K 
+++ and for i =1,2,...,n, K_i is an extension of K_{i-1} of degree > 1 
+++ and defined by an irreducible polynomial p(Z) in K_{i-1}.
+++ Two towers (T_1: K_01, K_11,...,K_i1,...,K_n1)  
+++ and (T_2: K_02, K_12,...,K_i2,...,K_n2)
+++ are said to be related if T_1 <= T_2 (or T_1 >= T_2), 
+++ that is if K_i1 = K_i2 for i=1,2,...,n1 (or i=1,2,...,n2). 
+++ Any algebraic operations defined for several elements 
+++ are only defined if all of the concerned elements are coming from 
+++ a set of related tower extensions. 
+PseudoAlgebraicClosureOfPerfectFieldCategory() : Category == PUB where
 
+ INT      ==> Integer
+ K        ==> Fraction Integer
+ NNI      ==> NonNegativeInteger
+ SUP      ==> SparseUnivariatePolynomial
+ BOOLEAN  ==> Boolean
+ PI       ==> PositiveInteger
+ FFFACTSE ==> FiniteFieldFactorizationWithSizeParseBySideEffect
 
-        sqrt(x,n) ==
-          n = 0 => 1
-          n = 1 => x
-          zero?(x) => 0
-          one?(x) => 1 
-          if odd?(n)
-          then
-            r := rootOf(monomial(1,n) - (x :: PME), 1)
-          else
-            r := rootOf(monomial(1,n) - (x :: PME), 2)
-          r case "failed" => error "no roots"
-          n = 2 => rename(r,root(x::E)$E)
-          rename(r,root(x :: E, n :: E)$E)
+ PUB ==> Field with 
 
-        (x : $) ** (rn : RN) == sqrt(x**numer(rn),denom(rn)::N)
+  definingPolynomial: () -> SUP(%)
+  definingPolynomial: % -> SUP %
 
-        nthRoot(x, n) == 
-          zero?(n) => x
-          negative?(n) => inv(sqrt(x,(-n) :: N))
-          sqrt(x,n :: N)
+  lift: % -> SUP(%)
+  lift: (%,%) -> SUP(%)
+  reduce: SUP(%) -> %
 
-        allRootsOf(p:SUP(RN)) == allRootsOf(map(z +-> z::$ ,p)$PACK(RN,$))
+  distinguishedRootsOf: (SparseUnivariatePolynomial %,%) -> List %
+    ++ distinguishedRootsOf(p,a) returns a (distinguised) root for each
+    ++ irreducible factor of the polynomial p (factored over the field defined
+    ++ by the element a). 
+  
+  ground_? : % -> Boolean
+  maxTower: List % -> %
+    ++ maxTower(l) returns the tower in the list having the maximal extension 
+    ++ degree over the ground field. It has no meaning if the towers are 
+    ++ not related.
+  extDegree: % -> PI
+    ++ extDegree(a) returns the extension degree of the extension tower 
+    ++ over which the element is defined.
+  previousTower: % -> %
+    ++ previousTower(a) returns the previous tower extension over which
+    ++ the element a is defined.
 
-        allRootsOf(p:SUP(Z)) == allRootsOf(map(z +-> z::$ ,p)$PACK(Z,$))
+  vectorise: (%,%) -> Vector(%)
 
-        allRootsOf(p:POLY($)) == allRootsOf(univariate(p))
+  conjugate: % -> %
+  newElement: (SUP(%), %, Symbol) -> %
+  newElement: (SUP(%), Symbol) -> %
+  setTower_!: % -> Void
+  fullOutput: % -> OutputForm
 
-        allRootsOf(p:POLY(RN)) == allRootsOf(univariate(p))
+\end{chunk}
 
-        allRootsOf(p:POLY(Z)) == allRootsOf(univariate(p))
+\begin{chunk}{PACPERC.dotabb}
+"PACPERC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACPERC"];
+"PACPERC" -> "FIELD"
 
 \end{chunk}
-\begin{chunk}{RCFIELD.dotabb}
-"RCFIELD"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=RCFIELD"];
-"RCFIELD" -> "ALGEBRA"
-"RCFIELD" -> "CHARZ"
-"RCFIELD" -> "COMRING"
-"RCFIELD" -> "FIELD"
-"RCFIELD" -> "FRETRCT"
-"RCFIELD" -> "ORDRING"
-"RCFIELD" -> "RADCAT"
 
-\end{chunk}
-\begin{chunk}{RCFIELD.dotfull}
-"RealClosedField()" 
- [color=lightblue,href="bookvol10.2.pdf#nameddest=RCFIELD"];
-"RealClosedField()" -> "Algebra(Integer)"
-"RealClosedField()" -> "Algebra(Fraction(Integer))"
-"RealClosedField()" -> "CharacteristicZero()"
-"RealClosedField()" -> "CommutativeRing()"
-"RealClosedField()" -> "Field()"
-"RealClosedField()" -> "FullyRetractableTo(Fraction(Integer))"
-"RealClosedField()" -> "OrderedRing()"
-"RealClosedField()" -> "RadicalCategory()"
+\begin{chunk}{PACPERC.dotfull}
+"PseudoAlgebraicClosureOfPerfectFieldCategory"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=PACPERC"];
+"PseudoAlgebraicClosureOfPerfectFieldCategory" -> "Field()"
 
 \end{chunk}
-\begin{chunk}{RCFIELD.dotpic}
+
+\begin{chunk}{PACPERC.dotpic}
 digraph pic {
  fontsize=10;
  bgcolor="#ECEA81";
  node [shape=box, color=white, style=filled];
 
-"RealClosedField()" [color=lightblue];
-"RealClosedField()" -> "ALGEBRA..."
-"RealClosedField()" -> "CHARZ..."
-"RealClosedField()" -> "COMRING..."
-"RealClosedField()" -> "FIELD..."
-"RealClosedField()" -> "FRETRCT..."
-"RealClosedField()" -> "ORDRING..."
-"RealClosedField()" -> "RADCAT..."
+"PseudoAlgebraicClosureOfPerfectFieldCategory" [color=lightblue];
+"PseudoAlgebraicClosureOfPerfectFieldCategory" -> "FIELD..."
 
-"ALGEBRA..." [color=lightblue];
-"CHARZ..." [color=lightblue];
-"COMRING..." [color=lightblue];
 "FIELD..." [color=lightblue];
-"FRETRCT..." [color=lightblue];
-"ORDRING..." [color=lightblue];
-"RADCAT..." [color=lightblue];
 
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\pagehead{RealNumberSystem}{RNS}
-\pagepic{ps/v102realnumbersystem.ps}{RNS}{0.50}
+\pagehead{QuotientFieldCategory}{QFCAT}
+\pagepic{ps/v102quotientfieldcategory.ps}{QFCAT}{0.50}
 
-\begin{chunk}{RealNumberSystem.input}
+\begin{chunk}{QuotientFieldCategory.input}
 )set break resume
-)sys rm -f RealNumberSystem.output
-)spool RealNumberSystem.output
+)sys rm -f QuotientFieldCategory.output
+)spool QuotientFieldCategory.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show RealNumberSystem
+)show QuotientFieldCategory
 --R 
---R RealNumberSystem  is a category constructor
---R Abbreviation for RealNumberSystem is RNS 
+--R QuotientFieldCategory(S: IntegralDomain)  is a category constructor
+--R Abbreviation for QuotientFieldCategory is QFCAT 
 --R This constructor is exposed in this frame.
---R Issue )edit bookvol10.2.pamphlet to see algebra source code for RNS 
+--R Issue )edit bookvol10.2.pamphlet to see algebra source code for QFCAT 
 --R
 --R------------------------------- Operations --------------------------------
+--R ?*? : (%,S) -> %                      ?*? : (S,%) -> %
 --R ?*? : (Fraction(Integer),%) -> %      ?*? : (%,Fraction(Integer)) -> %
 --R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
 --R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,Fraction(Integer)) -> %     ?**? : (%,Integer) -> %
---R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
---R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
---R -? : % -> %                           ?/? : (%,%) -> %
---R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
---R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
---R ?>=? : (%,%) -> Boolean               1 : () -> %
+--R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
+--R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?/? : (S,S) -> %                      ?/? : (%,%) -> %
+--R ?=? : (%,%) -> Boolean                D : (%,(S -> S)) -> %
+--R D : % -> % if S has DIFRING           1 : () -> %
 --R 0 : () -> %                           ?^? : (%,Integer) -> %
 --R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R abs : % -> %                          associates? : (%,%) -> Boolean
---R ceiling : % -> %                      coerce : Fraction(Integer) -> %
---R coerce : Integer -> %                 coerce : Fraction(Integer) -> %
---R coerce : % -> %                       coerce : Integer -> %
---R coerce : % -> OutputForm              convert : % -> Pattern(Float)
---R convert : % -> DoubleFloat            convert : % -> Float
---R factor : % -> Factored(%)             floor : % -> %
---R fractionPart : % -> %                 gcd : List(%) -> %
---R gcd : (%,%) -> %                      hash : % -> SingleInteger
+--R abs : % -> % if S has OINTDOM         associates? : (%,%) -> Boolean
+--R ceiling : % -> S if S has INS         coerce : S -> %
+--R coerce : Fraction(Integer) -> %       coerce : % -> %
+--R coerce : Integer -> %                 coerce : % -> OutputForm
+--R convert : % -> Float if S has REAL    denom : % -> S
+--R denominator : % -> %                  differentiate : (%,(S -> S)) -> %
+--R factor : % -> Factored(%)             floor : % -> S if S has INS
+--R gcd : List(%) -> %                    gcd : (%,%) -> %
+--R hash : % -> SingleInteger             init : () -> % if S has STEP
 --R inv : % -> %                          latex : % -> String
 --R lcm : List(%) -> %                    lcm : (%,%) -> %
---R max : (%,%) -> %                      min : (%,%) -> %
---R negative? : % -> Boolean              norm : % -> %
---R nthRoot : (%,Integer) -> %            one? : % -> Boolean
---R positive? : % -> Boolean              prime? : % -> Boolean
---R ?quo? : (%,%) -> %                    recip : % -> Union(%,"failed")
---R ?rem? : (%,%) -> %                    retract : % -> Fraction(Integer)
---R retract : % -> Integer                round : % -> %
---R sample : () -> %                      sign : % -> Integer
---R sizeLess? : (%,%) -> Boolean          sqrt : % -> %
+--R map : ((S -> S),%) -> %               max : (%,%) -> % if S has ORDSET
+--R min : (%,%) -> % if S has ORDSET      numer : % -> S
+--R numerator : % -> %                    one? : % -> Boolean
+--R prime? : % -> Boolean                 ?quo? : (%,%) -> %
+--R random : () -> % if S has INS         recip : % -> Union(%,"failed")
+--R ?rem? : (%,%) -> %                    retract : % -> S
+--R sample : () -> %                      sizeLess? : (%,%) -> Boolean
 --R squareFree : % -> Factored(%)         squareFreePart : % -> %
---R truncate : % -> %                     unit? : % -> Boolean
---R unitCanonical : % -> %                wholePart : % -> Integer
---R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R unit? : % -> Boolean                  unitCanonical : % -> %
+--R wholePart : % -> S if S has EUCDOM    zero? : % -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R ?<? : (%,%) -> Boolean if S has ORDSET
+--R ?<=? : (%,%) -> Boolean if S has ORDSET
+--R ?>? : (%,%) -> Boolean if S has ORDSET
+--R ?>=? : (%,%) -> Boolean if S has ORDSET
+--R D : (%,(S -> S),NonNegativeInteger) -> %
+--R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL)
+--R D : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL)
+--R D : (%,List(Symbol)) -> % if S has PDRING(SYMBOL)
+--R D : (%,Symbol) -> % if S has PDRING(SYMBOL)
+--R D : (%,NonNegativeInteger) -> % if S has DIFRING
 --R characteristic : () -> NonNegativeInteger
+--R charthRoot : % -> Union(%,"failed") if S has CHARNZ or and(has($,CharacteristicNonZero),has(S,PolynomialFactorizationExplicit))
+--R coerce : Symbol -> % if S has RETRACT(SYMBOL)
+--R conditionP : Matrix(%) -> Union(Vector(%),"failed") if and(has($,CharacteristicNonZero),has(S,PolynomialFactorizationExplicit))
+--R convert : % -> DoubleFloat if S has REAL
+--R convert : % -> InputForm if S has KONVERT(INFORM)
+--R convert : % -> Pattern(Float) if S has KONVERT(PATTERN(FLOAT))
+--R convert : % -> Pattern(Integer) if S has KONVERT(PATTERN(INT))
+--R differentiate : (%,(S -> S),NonNegativeInteger) -> %
+--R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL)
+--R differentiate : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL)
+--R differentiate : (%,List(Symbol)) -> % if S has PDRING(SYMBOL)
+--R differentiate : (%,Symbol) -> % if S has PDRING(SYMBOL)
+--R differentiate : (%,NonNegativeInteger) -> % if S has DIFRING
+--R differentiate : % -> % if S has DIFRING
 --R divide : (%,%) -> Record(quotient: %,remainder: %)
+--R ?.? : (%,S) -> % if S has ELTAB(S,S)
 --R euclideanSize : % -> NonNegativeInteger
+--R eval : (%,Symbol,S) -> % if S has IEVALAB(SYMBOL,S)
+--R eval : (%,List(Symbol),List(S)) -> % if S has IEVALAB(SYMBOL,S)
+--R eval : (%,List(Equation(S))) -> % if S has EVALAB(S)
+--R eval : (%,Equation(S)) -> % if S has EVALAB(S)
+--R eval : (%,S,S) -> % if S has EVALAB(S)
+--R eval : (%,List(S),List(S)) -> % if S has EVALAB(S)
 --R expressIdealMember : (List(%),%) -> Union(List(%),"failed")
 --R exquo : (%,%) -> Union(%,"failed")
 --R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
 --R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
+--R factorPolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT
+--R factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT
+--R fractionPart : % -> % if S has EUCDOM
 --R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
 --R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
 --R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
---R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%)
+--R negative? : % -> Boolean if S has OINTDOM
+--R nextItem : % -> Union(%,"failed") if S has STEP
+--R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if S has PATMAB(FLOAT)
+--R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if S has PATMAB(INT)
+--R positive? : % -> Boolean if S has OINTDOM
 --R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
---R retractIfCan : % -> Union(Fraction(Integer),"failed")
---R retractIfCan : % -> Union(Integer,"failed")
+--R reducedSystem : Matrix(%) -> Matrix(S)
+--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(S),vec: Vector(S))
+--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if S has LINEXP(INT)
+--R reducedSystem : Matrix(%) -> Matrix(Integer) if S has LINEXP(INT)
+--R retract : % -> Integer if S has RETRACT(INT)
+--R retract : % -> Fraction(Integer) if S has RETRACT(INT)
+--R retract : % -> Symbol if S has RETRACT(SYMBOL)
+--R retractIfCan : % -> Union(Integer,"failed") if S has RETRACT(INT)
+--R retractIfCan : % -> Union(Fraction(Integer),"failed") if S has RETRACT(INT)
+--R retractIfCan : % -> Union(Symbol,"failed") if S has RETRACT(SYMBOL)
+--R retractIfCan : % -> Union(S,"failed")
+--R sign : % -> Integer if S has OINTDOM
+--R solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> Union(List(SparseUnivariatePolynomial(%)),"failed") if S has PFECAT
+--R squareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if S has PFECAT
 --R subtractIfCan : (%,%) -> Union(%,"failed")
 --R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
 --R
@@ -65282,134 +73541,199 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{RealNumberSystem.help}
+
+\begin{chunk}{QuotientFieldCategory.help}
 ====================================================================
-RealNumberSystem examples
+QuotientFieldCategory examples
 ====================================================================
 
-The real number system category is intended as a model for the real
-numbers.  The real numbers form an ordered normed field.  Note that
-we have purposely not included DifferentialRing or the elementary 
-functions (see TranscendentalFunctionCategory) in the definition.
+QuotientField(S) is the category of fractions of an Integral Domain S.
 
 See Also:
-o )show RealNumberSystem
-o )show TranscendentalFunctionCategory
+o )show QuotientFieldCategory
 
 \end{chunk}
 {\bf See:}
 
-\pageto{FloatingPointSystem}{FPS}
+\pagefrom{Algebra}{ALGEBRA}
+\pagefrom{CharacteristicNonZero}{CHARNZ}
 \pagefrom{CharacteristicZero}{CHARZ}
 \pagefrom{ConvertibleTo}{KONVERT}
+\pagefrom{DifferentialExtension}{DIFEXT}
+\pagefrom{EuclideanDomain}{EUCDOM}
 \pagefrom{Field}{FIELD}
-\pagefrom{OrderedRing}{ORDRING}
-\pagefrom{PatternMatchable}{PATMAB}
-\pagefrom{RadicalCategory}{RADCAT}
+\pagefrom{FullyEvalableOver}{FEVALAB}
+\pagefrom{FullyLinearlyExplicitRingOver}{FLINEXP}
+\pagefrom{FullyPatternMatchable}{FPATMAB}
+\pagefrom{OrderedIntegralDomain}{OINTDOM}
+\pagefrom{OrderedSet}{ORDSET}
+\pagefrom{Patternable}{PATAB}
+\pagefrom{PolynomialFactorizationExplicit}{PFECAT}
 \pagefrom{RealConstant}{REAL}
 \pagefrom{RetractableTo}{RETRACT}
+\pagefrom{StepThrough}{STEP}
 
 {\bf Exports:}\\
 
-\begin{tabular}{llll}
-\cross{RNS}{0} &
-\cross{RNS}{1} &
-\cross{RNS}{abs} &
-\cross{RNS}{associates?} \\
-\cross{RNS}{ceiling} &
-\cross{RNS}{characteristic} &
-\cross{RNS}{coerce} &
-\cross{RNS}{convert} \\
-\cross{RNS}{divide} &
-\cross{RNS}{euclideanSize} &
-\cross{RNS}{expressIdealMember} &
-\cross{RNS}{exquo} \\
-\cross{RNS}{extendedEuclidean} &
-\cross{RNS}{factor} &
-\cross{RNS}{floor} &
-\cross{RNS}{fractionPart} \\
-\cross{RNS}{gcd} &
-\cross{RNS}{gcdPolynomial} &
-\cross{RNS}{hash} &
-\cross{RNS}{inv} \\
-\cross{RNS}{latex} &
-\cross{RNS}{lcm} &
-\cross{RNS}{max} &
-\cross{RNS}{min} \\
-\cross{RNS}{multiEuclidean} &
-\cross{RNS}{negative?} &
-\cross{RNS}{norm} &
-\cross{RNS}{nthRoot} \\
-\cross{RNS}{one?} &
-\cross{RNS}{patternMatch} &
-\cross{RNS}{positive?} &
-\cross{RNS}{prime?} \\
-\cross{RNS}{principalIdeal} &
-\cross{RNS}{recip} &
-\cross{RNS}{retract} &
-\cross{RNS}{retractIfCan} \\
-\cross{RNS}{round} &
-\cross{RNS}{sample} &
-\cross{RNS}{sign} &
-\cross{RNS}{sizeLess?} \\
-\cross{RNS}{sqrt} &
-\cross{RNS}{squareFree} &
-\cross{RNS}{squareFreePart} &
-\cross{RNS}{subtractIfCan} \\
-\cross{RNS}{truncate} &
-\cross{RNS}{unit?} &
-\cross{RNS}{unitCanonical} &
-\cross{RNS}{unitNormal} \\
-\cross{RNS}{wholePart} &
-\cross{RNS}{zero?} &
-\cross{RNS}{?*?} &
-\cross{RNS}{?**?} \\
-\cross{RNS}{?+?} &
-\cross{RNS}{?-?} &
-\cross{RNS}{-?} &
-\cross{RNS}{?/?} \\
-\cross{RNS}{?$<$?} &
-\cross{RNS}{?$<=$?} &
-\cross{RNS}{?=?} &
-\cross{RNS}{?$>$?} \\
-\cross{RNS}{?$>=$?} &
-\cross{RNS}{?\^{}?} &
-\cross{RNS}{?quo?} &
-\cross{RNS}{?rem?} \\
-\cross{RNS}{?\~{}=?} &&
+\begin{tabular}{lllll}
+\cross{QFCAT}{0} &
+\cross{QFCAT}{1} &
+\cross{QFCAT}{abs} \\
+\cross{QFCAT}{associates?} &
+\cross{QFCAT}{ceiling} &
+\cross{QFCAT}{characteristic} \\
+\cross{QFCAT}{charthRoot} &
+\cross{QFCAT}{coerce} &
+\cross{QFCAT}{conditionP} \\
+\cross{QFCAT}{convert} &
+\cross{QFCAT}{D} &
+\cross{QFCAT}{denom} \\
+\cross{QFCAT}{denominator} &
+\cross{QFCAT}{differentiate} &
+\cross{QFCAT}{divide} \\
+\cross{QFCAT}{euclideanSize} &
+\cross{QFCAT}{eval} &
+\cross{QFCAT}{expressIdealMember} \\
+\cross{QFCAT}{exquo} &
+\cross{QFCAT}{extendedEuclidean} &
+\cross{QFCAT}{factor} \\
+\cross{QFCAT}{factorPolynomial} &
+\cross{QFCAT}{factorSquareFreePolynomial} &
+\cross{QFCAT}{floor} \\
+\cross{QFCAT}{fractionPart} &
+\cross{QFCAT}{gcd} &
+\cross{QFCAT}{gcdPolynomial} \\
+\cross{QFCAT}{hash} &
+\cross{QFCAT}{init} &
+\cross{QFCAT}{inv} \\
+\cross{QFCAT}{latex} &
+\cross{QFCAT}{lcm} &
+\cross{QFCAT}{map} \\
+\cross{QFCAT}{max} &
+\cross{QFCAT}{min} &
+\cross{QFCAT}{multiEuclidean} \\
+\cross{QFCAT}{negative?} &
+\cross{QFCAT}{nextItem} &
+\cross{QFCAT}{numer} \\
+\cross{QFCAT}{numerator} &
+\cross{QFCAT}{one?} &
+\cross{QFCAT}{patternMatch} \\
+\cross{QFCAT}{positive?} &
+\cross{QFCAT}{prime?} &
+\cross{QFCAT}{principalIdeal} \\
+\cross{QFCAT}{random} &
+\cross{QFCAT}{recip} &
+\cross{QFCAT}{reducedSystem} \\
+\cross{QFCAT}{retract} &
+\cross{QFCAT}{retractIfCan} &
+\cross{QFCAT}{sample} \\
+\cross{QFCAT}{sign} &
+\cross{QFCAT}{sizeLess?} &
+\cross{QFCAT}{solveLinearPolynomialEquation} \\
+\cross{QFCAT}{squareFree} &
+\cross{QFCAT}{squareFreePart} &
+\cross{QFCAT}{squareFreePolynomial} \\
+\cross{QFCAT}{subtractIfCan} &
+\cross{QFCAT}{unit?} &
+\cross{QFCAT}{unitNormal} \\
+\cross{QFCAT}{unitCanonical} &
+\cross{QFCAT}{wholePart} &
+\cross{QFCAT}{zero?} \\
+\cross{QFCAT}{?.?} &
+\cross{QFCAT}{?*?} &
+\cross{QFCAT}{?**?} \\
+\cross{QFCAT}{?+?} &
+\cross{QFCAT}{?-?} &
+\cross{QFCAT}{-?} \\
+\cross{QFCAT}{?/?} &
+\cross{QFCAT}{?=?} &
+\cross{QFCAT}{?\^{}?} \\
+\cross{QFCAT}{?quo?} &
+\cross{QFCAT}{?rem?} &
+\cross{QFCAT}{?\~{}=?} \\
+\cross{QFCAT}{?$<$?} &
+\cross{QFCAT}{?$<=$?} &
+\cross{QFCAT}{?$>$?} \\
+\cross{QFCAT}{?$>=$?} &&
 \end{tabular}
 
+{\bf Attributes Exported:}
+\begin{itemize}
+\item {\bf \cross{QFCAT}{canonicalUnitNormal}}
+is true if we can choose a canonical representative for each class 
+of associate elements, that is {\tt associates?(a,b)} returns true 
+if and only if {\tt unitCanonical(a) = unitCanonical(b)}.
+\item {\bf \cross{QFCAT}{canonicalsClosed}}
+is true if\hfill\\
+{\tt unitCanonical(a)*unitCanonical(b) = unitCanonical(a*b)}.
+\item {\bf \cross{QFCAT}{noZeroDivisors}}
+is true if $x * y \ne 0$ implies both x and y are non-zero.
+\item {\bf \cross{QFCAT}{commutative(``*'')}}
+is true if it has an operation $"*": (D,D) -> D$
+which is commutative.
+\item {\bf \cross{QFCAT}{unitsKnown}}
+is true if a monoid (a multiplicative semigroup with a 1) has 
+unitsKnown means that  the operation {\tt recip} can only return 
+``failed'' if its argument is not a unit.
+\item {\bf \cross{QFCAT}{leftUnitary}}
+is true if $1 * x = x$ for all x.
+\item {\bf \cross{QFCAT}{rightUnitary}}
+is true if $x * 1 = x$ for all x.
+\item {\bf nil}
+\end{itemize}
+
 These are directly exported but not implemented:
 \begin{verbatim}
- abs : % -> %
- wholePart : % -> Integer             
+ ceiling : % -> S if S has INS        
+ denom : % -> S                       
+ floor : % -> S if S has INS
+ numer : % -> S
+ wholePart : % -> S if S has EUCDOM
+ ?/? : (S,S) -> %                     
 \end{verbatim}
 
 These are implemented by this category:
 \begin{verbatim}
  characteristic : () -> NonNegativeInteger
- ceiling : % -> %
+ coerce : Symbol -> % if S has RETRACT SYMBOL
  coerce : Fraction Integer -> %       
- convert : % -> Pattern Float         
- floor : % -> %                       
- fractionPart : % -> %
- norm : % -> %                        
+ convert : % -> InputForm if S has KONVERT INFORM
+ convert : % -> DoubleFloat if S has REAL
+ convert : % -> Float if S has REAL
+ convert : % -> Pattern Integer if S has KONVERT PATTERN INT
+ convert : % -> Pattern Float if S has KONVERT PATTERN FLOAT
+ denominator : % -> %
+ differentiate : (%,(S -> S)) -> %
+ fractionPart : % -> % if S has EUCDOM
+ init : () -> % if S has STEP
+ map : ((S -> S),%) -> %              
+ nextItem : % -> Union(%,"failed") if S has STEP
+ numerator : % -> %                   
  patternMatch :
-   (%,Pattern Float,PatternMatchResult(Float,%)) -> 
-     PatternMatchResult(Float,%)
- round : % -> %                       
- truncate : % -> %
+   (%,Pattern Float,PatternMatchResult(Float,%)) ->
+     PatternMatchResult(Float,%) 
+      if S has PATMAB FLOAT
+ patternMatch : 
+   (%,Pattern Integer,PatternMatchResult(Integer,%)) ->
+     PatternMatchResult(Integer,%) 
+       if S has PATMAB INT
+ random : () -> % if S has INS        
+ reducedSystem : Matrix % -> Matrix S
+ reducedSystem : (Matrix %,Vector %) -> Record(mat: Matrix S,vec: Vector S)
+ retract : % -> Symbol if S has RETRACT SYMBOL
+ retract : % -> Integer if S has RETRACT INT
+ retractIfCan : % -> Union(Integer,"failed") if S has RETRACT INT
+ retractIfCan : % -> Union(Symbol,"failed") if S has RETRACT SYMBOL
+ ?<? : (%,%) -> Boolean if S has ORDSET
 \end{verbatim}
 
 These exports come from \refto{Field}():
 \begin{verbatim}
  0 : () -> %                          
  1 : () -> %
- associates? : (%,%) -> Boolean       
+ associates? : (%,%) -> Boolean
  coerce : % -> %
- coerce : Integer -> %
  coerce : Integer -> %                
- coerce : Fraction Integer -> %       
  coerce : % -> OutputForm
  divide : (%,%) -> Record(quotient: %,remainder: %)
  euclideanSize : % -> NonNegativeInteger
@@ -65417,1309 +73741,3567 @@ These exports come from \refto{Field}():
  extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
  extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
  exquo : (%,%) -> Union(%,"failed")
- factor : % -> Factored %
- gcd : List % -> %                    
+ factor : % -> Factored %             
  gcd : (%,%) -> %
+ gcd : List % -> %                    
  gcdPolynomial : 
    (SparseUnivariatePolynomial %,
     SparseUnivariatePolynomial %) ->
-       SparseUnivariatePolynomial %
+      SparseUnivariatePolynomial %
  hash : % -> SingleInteger            
- inv : % -> %
- latex : % -> String                  
- lcm : List % -> %
- lcm : (%,%) -> %                     
+ inv : % -> %                         
+ latex : % -> String
+ lcm : List % -> %                    
+ lcm : (%,%) -> %
  multiEuclidean : (List %,%) -> Union(List %,"failed")
- one? : % -> Boolean                  
+ one? : % -> Boolean
  prime? : % -> Boolean                
  principalIdeal : List % -> Record(coef: List %,generator: %)
- recip : % -> Union(%,"failed")       
- sample : () -> %
+ recip : % -> Union(%,"failed")
+ sample : () -> %                     
  sizeLess? : (%,%) -> Boolean
- squareFree : % -> Factored %
- squareFreePart : % -> %              
+ squareFree : % -> Factored %         
+ squareFreePart : % -> %
  subtractIfCan : (%,%) -> Union(%,"failed")
  unit? : % -> Boolean                 
  unitCanonical : % -> %
  unitNormal : % -> Record(unit: %,canonical: %,associate: %)
- zero? : % -> Boolean
- ?+? : (%,%) -> %                     
- ?=? : (%,%) -> Boolean               
- ?~=? : (%,%) -> Boolean              
+ zero? : % -> Boolean                 
  ?*? : (Fraction Integer,%) -> %      
  ?*? : (%,Fraction Integer) -> %
- ?**? : (%,Fraction Integer) -> %
+ ?**? : (%,Integer) -> %
  ?^? : (%,Integer) -> %
+ ?+? : (%,%) -> %
+ ?=? : (%,%) -> Boolean               
+ ?~=? : (%,%) -> Boolean
  ?*? : (%,%) -> %                     
  ?*? : (Integer,%) -> %
  ?*? : (PositiveInteger,%) -> %       
  ?*? : (NonNegativeInteger,%) -> %
- ?-? : (%,%) -> %
- -? : % -> %                          
- ?**? : (%,PositiveInteger) -> %
+ ?-? : (%,%) -> %                     
+ -? : % -> %
+ ?**? : (%,PositiveInteger) -> %      
  ?**? : (%,NonNegativeInteger) -> %
  ?^? : (%,NonNegativeInteger) -> %
  ?^? : (%,PositiveInteger) -> %       
  ?/? : (%,%) -> %
  ?quo? : (%,%) -> %
- ?rem? : (%,%) -> %
+ ?rem? : (%,%) -> %                   
 \end{verbatim}
 
-These exports come from \refto{OrderedRing}():
+These exports come from \refto{Algebra}(S:IntegralDomain):
 \begin{verbatim}
- negative? : % -> Boolean
- positive? : % -> Boolean
- sign : % -> Integer                  
- max : (%,%) -> %
- min : (%,%) -> %                     
- ?<? : (%,%) -> Boolean               
- ?<=? : (%,%) -> Boolean
- ?>? : (%,%) -> Boolean
- ?>=? : (%,%) -> Boolean              
+ coerce : S -> %
+ ?*? : (%,S) -> %                     
+ ?*? : (S,%) -> %
 \end{verbatim}
 
-These exports come from \refto{RealConstant}():
+These exports come from \refto{RetractableTo}(S:IntegralDomain):
 \begin{verbatim}
- convert : % -> DoubleFloat
- convert : % -> Float                 
+ retract : % -> S
+ retractIfCan : % -> Union(S,"failed")
 \end{verbatim}
 
-These exports come from \refto{RetractableTo}(Integer):
+These exports come from \refto{FullyEvalableOver}(S:IntegralDomain):
 \begin{verbatim}
- retract : % -> Integer
- retractIfCan : % -> Union(Integer,"failed")
+ ?.? : (%,S) -> % if S has ELTAB(S,S)
+ eval : (%,Equation S) -> % if S has EVALAB S
+ eval : (%,List Symbol,List S) -> % if S has IEVALAB(SYMBOL,S)
+ eval : (%,List Equation S) -> % if S has EVALAB S
+ eval : (%,S,S) -> % if S has EVALAB S
+ eval : (%,List S,List S) -> % if S has EVALAB S
+ eval : (%,Symbol,S) -> % if S has IEVALAB(SYMBOL,S)
+\end{verbatim}
+
+These exports come from \refto{DifferentialExtension}(S:IntegralDomain):
+\begin{verbatim}
+ D : (%,(S -> S)) -> %
+ D : (%,(S -> S),NonNegativeInteger) -> %
+ D : % -> % if S has DIFRING          
+ D : (%,NonNegativeInteger) -> % if S has DIFRING
+ D : (%,List Symbol,List NonNegativeInteger) -> % 
+     if S has PDRING SYMBOL
+ D : (%,Symbol,NonNegativeInteger) -> % 
+     if S has PDRING SYMBOL
+ D : (%,List Symbol) -> % if S has PDRING SYMBOL
+ D : (%,Symbol) -> % if S has PDRING SYMBOL
+ differentiate : (%,List Symbol) -> % 
+     if S has PDRING SYMBOL
+ differentiate : (%,Symbol,NonNegativeInteger) -> % 
+     if S has PDRING SYMBOL
+ differentiate : (%,List Symbol,List NonNegativeInteger) -> % 
+     if S has PDRING SYMBOL
+ differentiate : (%,NonNegativeInteger) -> % if S has DIFRING
+ differentiate : % -> % if S has DIFRING
+ differentiate : (%,Symbol) -> % if S has PDRING SYMBOL
+ differentiate : (%,(S -> S),NonNegativeInteger) -> %
+\end{verbatim}
+
+These exports come from 
+\refto{FullyLinearlyExplicitRingOver}(S:IntegralDomain):
+\begin{verbatim}
+ reducedSystem : (Matrix %,Vector %) ->
+   Record(mat: Matrix Integer,vec: Vector Integer) 
+     if S has LINEXP INT
+ reducedSystem : Matrix % -> Matrix Integer if S has LINEXP INT
 \end{verbatim}
 
 These exports come from \refto{RetractableTo}(Fraction(Integer)):
 \begin{verbatim}
- retract : % -> Fraction Integer      
- retractIfCan : % -> Union(Fraction Integer,"failed")
+ retract : % -> Fraction Integer if S has RETRACT INT
+ retractIfCan : % -> Union(Fraction Integer,"failed") 
+   if S has RETRACT INT
 \end{verbatim}
 
-These exports come from \refto{RadicalCategory}():
+These exports come from \refto{OrderedSet}():
 \begin{verbatim}
- nthRoot : (%,Integer) -> %
- sqrt : % -> %                        
+ max : (%,%) -> % if S has ORDSET
+ min : (%,%) -> % if S has ORDSET
+ ?<=? : (%,%) -> Boolean if S has ORDSET
+ ?>? : (%,%) -> Boolean if S has ORDSET
+ ?>=? : (%,%) -> Boolean if S has ORDSET
 \end{verbatim}
 
-These exports come from \refto{ConvertibleTo}(Pattern(Float)):
+These exports come from \refto{OrderedIntegralDomain}():
 \begin{verbatim}
+ abs : % -> % if S has OINTDOM
+ negative? : % -> Boolean if S has OINTDOM
+ positive? : % -> Boolean if S has OINTDOM
+ sign : % -> Integer if S has OINTDOM
 \end{verbatim}
 
-These exports come from \refto{PatternMatchable}(Float):
+These exports come from \refto{CharacteristicNonZero}():
 \begin{verbatim}
+ charthRoot : % -> Union(%,"failed") 
+   if S has CHARNZ 
+   or and(has($,CharacteristicNonZero),
+          has(S,PolynomialFactorizationExplicit))
 \end{verbatim}
 
-These exports come from \refto{CharacteristicZero}():
+These exports come from \refto{PolynomialFactorizationExplicit}():
 \begin{verbatim}
+ conditionP : Matrix % -> Union(Vector %,"failed") 
+   if and(has($,CharacteristicNonZero),
+          has(S,PolynomialFactorizationExplicit))
+ factorPolynomial : 
+   SparseUnivariatePolynomial % -> 
+     Factored SparseUnivariatePolynomial % 
+       if S has PFECAT
+ factorSquareFreePolynomial : 
+   SparseUnivariatePolynomial % -> 
+     Factored SparseUnivariatePolynomial % 
+       if S has PFECAT
+ solveLinearPolynomialEquation : 
+   (List SparseUnivariatePolynomial %,
+    SparseUnivariatePolynomial %) -> 
+      Union(List SparseUnivariatePolynomial %,"failed") 
+       if S has PFECAT
+ squareFreePolynomial : 
+   SparseUnivariatePolynomial % -> 
+     Factored SparseUnivariatePolynomial % 
+       if S has PFECAT
 \end{verbatim}
 
-\begin{chunk}{category RNS RealNumberSystem}
-)abbrev category RNS RealNumberSystem
-++ Author: Michael Monagan and Stephen M. Watt
-++ Date Created: January 1988
-++ Description:  
-++ The real number system category is intended as a model for the real
-++ numbers.  The real numbers form an ordered normed field.  Note that
-++ we have purposely not included \spadtype{DifferentialRing} or 
-++ the elementary functions (see \spadtype{TranscendentalFunctionCategory})
-++ in the definition.
+\begin{chunk}{category QFCAT QuotientFieldCategory}
+)abbrev category QFCAT QuotientFieldCategory
+++ Date Last Updated: 5th March 1996 
+++ Description:
+++ QuotientField(S) is the category of fractions of an Integral Domain S.
+
+QuotientFieldCategory(S: IntegralDomain): Category ==
+  Join(Field, Algebra S, RetractableTo S, FullyEvalableOver S,
+         DifferentialExtension S, FullyLinearlyExplicitRingOver S,
+           Patternable S, FullyPatternMatchable S) with
+    _/     : (S, S) -> %
+       ++ d1 / d2 returns the fraction d1 divided by d2.
+    numer  : % -> S
+       ++ numer(x) returns the numerator of the fraction x.
+    denom  : % -> S
+       ++ denom(x) returns the denominator of the fraction x.
+    numerator : % -> %
+       ++ numerator(x) is the numerator of the fraction x converted to %.
+    denominator : % -> %
+       ++ denominator(x) is the denominator of the fraction x converted to %.
+    if S has StepThrough then StepThrough
+    if S has RetractableTo Integer then
+             RetractableTo Integer
+             RetractableTo Fraction Integer
+    if S has OrderedSet then OrderedSet
+    if S has OrderedIntegralDomain then OrderedIntegralDomain
+    if S has RealConstant then RealConstant
+    if S has ConvertibleTo InputForm then ConvertibleTo InputForm
+    if S has CharacteristicZero then CharacteristicZero
+    if S has CharacteristicNonZero then CharacteristicNonZero
+    if S has RetractableTo Symbol then RetractableTo Symbol
+    if S has EuclideanDomain then
+      wholePart: % -> S
+        ++ wholePart(x) returns the whole part of the fraction x
+        ++ i.e. the truncated quotient of the numerator by the denominator.
+      fractionPart: % -> %
+        ++ fractionPart(x) returns the fractional part of x.
+        ++ x = wholePart(x) + fractionPart(x)
+    if S has IntegerNumberSystem then
+      random: () -> %
+        ++ random() returns a random fraction.
+      ceiling : % -> S
+        ++ ceiling(x) returns the smallest integral element above x.
+      floor: % -> S
+        ++ floor(x) returns the largest integral element below x.
+    if S has PolynomialFactorizationExplicit then
+      PolynomialFactorizationExplicit
 
-RealNumberSystem(): Category ==
-  Join(Field, OrderedRing, RealConstant, RetractableTo Integer,
-       RetractableTo Fraction Integer, RadicalCategory,
-        ConvertibleTo Pattern Float, PatternMatchable Float,
-          CharacteristicZero) with
-    norm : % -> %
-      ++ norm x returns the same as absolute value.
-    ceiling : % -> %
-      ++ ceiling x returns the small integer \spad{>= x}.
-    floor: % -> %
-      ++ floor x returns the largest integer \spad{<= x}.
-    wholePart  : % -> Integer
-      ++ wholePart x returns the integer part of x.
-    fractionPart : % -> %
-      ++ fractionPart x returns the fractional part of x.
-    truncate: % -> %
-      ++ truncate x returns the integer between x and 0 closest to x.
-    round: % -> %
-      ++ round x computes the integer closest to x.
-    abs  : % -> %
-      ++ abs x returns the absolute value of x.
  add
-   characteristic() == 0
+    import MatrixCommonDenominator(S, %)
 
-   fractionPart x == x - truncate x
+    numerator(x) == numer(x)::%
 
-   truncate x == (negative? x => -floor(-x); floor x)
+    denominator(x) == denom(x) ::%
 
-   round x == (negative? x => truncate(x-1/2::%); truncate(x+1/2::%))
+    if S has StepThrough then
+       init() == init()$S / 1$S
 
-   norm x == abs x
+       nextItem(n) ==
+         m:= nextItem(numer(n))
+         m case "failed" =>
+           error "We seem to have a Fraction of a finite object"
+         m / 1
 
-   coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::%
+    map(fn, x)                         == (fn numer x) / (fn denom x)
 
-   convert(x:%):Pattern(Float)  == convert(x)@Float :: Pattern(Float)
+    reducedSystem(m:Matrix %):Matrix S == clearDenominator m
 
-   floor x ==
-      x1 := (wholePart x) :: %
-      x = x1 => x
-      x < 0 => (x1 - 1)
-      x1
+    characteristic()                   == characteristic()$S
 
-   ceiling x ==
-      x1 := (wholePart x)::%
-      x = x1 => x
-      x >= 0 => (x1 + 1)
-      x1
+    differentiate(x:%, deriv:S -> S) ==
+        n := numer x
+        d := denom x
+        (deriv n * d - n * deriv d) / (d**2)
 
-   patternMatch(x, p, l) ==
-     generic? p => addMatch(p, x, l)
-     constant? p =>
-       (r := retractIfCan(p)@Union(Float, "failed")) case Float =>
-         convert(x)@Float = r::Float => l
-         failed()
-       failed()
-     failed()
+    if S has ConvertibleTo InputForm then
+      convert(x:%):InputForm == (convert numer x) / (convert denom x)
 
-\end{chunk}
-\begin{chunk}{RNS.dotabb}
-"RNS"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=RNS"];
-"RNS" -> "FIELD"
-"RNS" -> "ORDRING"
-"RNS" -> "REAL"
-"RNS" -> "RETRACT"
-"RNS" -> "RADCAT"
-"RNS" -> "KONVERT"
-"RNS" -> "PATMAB"
-"RNS" -> "CHARZ"
+    if S has RealConstant then
+      convert(x:%):Float == (convert numer x) / (convert denom x)
 
-\end{chunk}
-\begin{chunk}{RNS.dotfull}
-"RealNumberSystem()"
- [color=lightblue,href="bookvol10.2.pdf#nameddest=RNS"];
-"RealNumberSystem()" -> "Field()"
-"RealNumberSystem()" -> "OrderedRing()"
-"RealNumberSystem()" -> "RealConstant()"
-"RealNumberSystem()" -> "RetractableTo(Integer)"
-"RealNumberSystem()" -> "RetractableTo(Fraction(Integer))"
-"RealNumberSystem()" -> "RadicalCategory()"
-"RealNumberSystem()" -> "ConvertibleTo(Pattern(Float))"
-"RealNumberSystem()" -> "PatternMatchable(Float)"
-"RealNumberSystem()" -> "CharacteristicZero()"
+      convert(x:%):DoubleFloat == (convert numer x) / (convert denom x)
 
-\end{chunk}
-\begin{chunk}{RNS.dotpic}
-digraph pic {
- fontsize=10;
- bgcolor="#ECEA81";
- node [shape=box, color=white, style=filled];
+    -- Note that being a Join(OrderedSet,IntegralDomain) is not the same 
+    -- as being an OrderedIntegralDomain.
+    if S has OrderedIntegralDomain then
+       if S has canonicalUnitNormal then
+           x:% < y:% ==
+             (numer x  * denom y) < (numer y * denom x)
+         else
+           x:% < y:% ==
+             if denom(x) < 0 then (x,y):=(y,x)
+             if denom(y) < 0 then (x,y):=(y,x)
+             (numer x  * denom y) < (numer y * denom x)
+    else if S has OrderedSet then
+       x:% < y:% ==
+         (numer x  * denom y) < (numer y * denom x)
 
-"RealNumberSystem()" [color=lightblue];
-"RealNumberSystem()" -> "FIELD..."
-"RealNumberSystem()" -> "ORDRING..."
-"RealNumberSystem()" -> "REAL..."
-"RealNumberSystem()" -> "RETRACT..."
-"RealNumberSystem()" -> "RADCAT..."
-"RealNumberSystem()" -> "KONVERT..."
-"RealNumberSystem()" -> "PATMAB..."
-"RealNumberSystem()" -> "CHARZ..."
+    if (S has EuclideanDomain) then
+      fractionPart x == x - (wholePart(x)::%)
 
-"FIELD..." [color=lightblue];
-"ORDRING..." [color=lightblue];
-"REAL..." [color=lightblue];
-"RETRACT..." [color=lightblue];
-"RADCAT..." [color=lightblue];
-"KONVERT..." [color=lightblue];
-"PATMAB..." [color=lightblue];
-"CHARZ..." [color=lightblue];
-}
+    if S has RetractableTo Symbol then
+      coerce(s:Symbol):%  == s::S::%
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\pagehead{RecursivePolynomialCategory}{RPOLCAT}
-\pagepic{ps/v102recursivepolynomialcategory.ps}{RPOLCAT}{0.30}
+      retract(x:%):Symbol == retract(retract(x)@S)
 
-\begin{chunk}{RecursivePolynomialCategory.input}
+      retractIfCan(x:%):Union(Symbol, "failed") ==
+        (r := retractIfCan(x)@Union(S,"failed")) case "failed" =>"failed"
+        retractIfCan(r::S)
+
+    if (S has ConvertibleTo Pattern Integer) then
+      convert(x:%):Pattern(Integer)==(convert numer x)/(convert denom x)
+
+      if (S has PatternMatchable Integer) then
+        patternMatch(x:%, p:Pattern Integer,
+         l:PatternMatchResult(Integer, %)) ==
+           patternMatch(x, p,
+                     l)$PatternMatchQuotientFieldCategory(Integer, S, %)
+
+    if (S has ConvertibleTo Pattern Float) then
+      convert(x:%):Pattern(Float) == (convert numer x)/(convert denom x)
+
+      if (S has PatternMatchable Float) then
+        patternMatch(x:%, p:Pattern Float,
+         l:PatternMatchResult(Float, %)) ==
+           patternMatch(x, p,
+                       l)$PatternMatchQuotientFieldCategory(Float, S, %)
+
+    if S has RetractableTo Integer then
+      coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::%
+
+      if not(S is Integer) then
+        retract(x:%):Integer == retract(retract(x)@S)
+
+        retractIfCan(x:%):Union(Integer, "failed") ==
+          (u := retractIfCan(x)@Union(S, "failed")) case "failed" =>
+            "failed"
+          retractIfCan(u::S)
+
+    if S has IntegerNumberSystem then
+      random():% ==
+        while zero?(d:=random()$S) repeat d
+        random()$S / d
+
+    reducedSystem(m:Matrix %, v:Vector %):
+      Record(mat:Matrix S, vec:Vector S) ==
+        n := reducedSystem(horizConcat(v::Matrix(%), m))@Matrix(S)
+        [subMatrix(n, minRowIndex n, maxRowIndex n, 1 + minColIndex n,
+                                maxColIndex n), column(n, minColIndex n)]
+
+\end{chunk}
+
+\begin{chunk}{COQ QFCAT}
+(* category QFCAT *)
+(*
+    import MatrixCommonDenominator(S, %)
+
+    numerator : % -> %
+    numerator(x) == numer(x)::%
+
+    denominator : % -> %
+    denominator(x) == denom(x) ::%
+
+    if S has StepThrough then
+
+       init : () -> %
+       init() == init()$S / 1$S
+
+       nextItem : % -> Union(%,"failed")
+       nextItem(n) ==
+         m:= nextItem(numer(n))
+         m case "failed" =>
+           error "We seem to have a Fraction of a finite object"
+         m / 1
+
+    map : ((S -> S),%) -> %
+    map(fn, x) == (fn numer x) / (fn denom x)
+
+    reducedSystem : Matrix(%) -> Matrix(S)
+    reducedSystem(m:Matrix %):Matrix S == clearDenominator m
+
+    characteristic : () -> NonNegativeInteger
+    characteristic() == characteristic()$S
+
+    differentiate : (%,(S -> S)) -> %
+    differentiate(x:%, deriv:S -> S) ==
+        n := numer x
+        d := denom x
+        (deriv n * d - n * deriv d) / (d**2)
+
+    if S has ConvertibleTo InputForm then
+
+      convert : % -> InputForm
+      convert(x:%):InputForm == (convert numer x) / (convert denom x)
+
+    if S has RealConstant then
+
+      convert : % -> Float
+      convert(x:%):Float == (convert numer x) / (convert denom x)
+
+      convert : % -> DoubleFloat
+      convert(x:%):DoubleFloat == (convert numer x) / (convert denom x)
+
+    -- Note that being a Join(OrderedSet,IntegralDomain) is not the same 
+    -- as being an OrderedIntegralDomain.
+    if S has OrderedIntegralDomain then
+
+       if S has canonicalUnitNormal then
+
+           ?<? : (%,%) -> Boolean
+           x:% < y:% ==
+             (numer x  * denom y) < (numer y * denom x)
+
+         else
+
+           ?<? : (%,%) -> Boolean
+           x:% < y:% ==
+             if denom(x) < 0 then (x,y):=(y,x)
+             if denom(y) < 0 then (x,y):=(y,x)
+             (numer x  * denom y) < (numer y * denom x)
+
+    else if S has OrderedSet then
+
+       ?<? : (%,%) -> Boolean
+       x:% < y:% ==
+         (numer x  * denom y) < (numer y * denom x)
+
+    if (S has EuclideanDomain) then
+
+      fractionPart : % -> %
+      fractionPart x == x - (wholePart(x)::%)
+
+    if S has RetractableTo Symbol then
+
+      coerce : S -> %
+      coerce(s:Symbol):%  == s::S::%
+
+      retract : % -> S
+      retract(x:%):Symbol == retract(retract(x)@S)
+
+      retractIfCan : % -> Union(Symbol,"failed")
+      retractIfCan(x:%):Union(Symbol, "failed") ==
+        (r := retractIfCan(x)@Union(S,"failed")) case "failed" =>"failed"
+        retractIfCan(r::S)
+
+    if (S has ConvertibleTo Pattern Integer) then
+
+      convert : % -> Pattern(Integer)
+      convert(x:%):Pattern(Integer)==(convert numer x)/(convert denom x)
+
+      if (S has PatternMatchable Integer) then
+
+        patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) ->
+           PatternMatchResult(Integer,%)
+        patternMatch(x:%, p:Pattern Integer,
+         l:PatternMatchResult(Integer, %)) ==
+           patternMatch(x, p,
+                     l)$PatternMatchQuotientFieldCategory(Integer, S, %)
+
+    if (S has ConvertibleTo Pattern Float) then
+
+      convert : % -> Pattern(Float)
+      convert(x:%):Pattern(Float) == (convert numer x)/(convert denom x)
+
+      if (S has PatternMatchable Float) then
+
+        patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) ->
+            PatternMatchResult(Float,%)
+        patternMatch(x:%, p:Pattern Float,
+         l:PatternMatchResult(Float, %)) ==
+           patternMatch(x, p,
+                       l)$PatternMatchQuotientFieldCategory(Float, S, %)
+
+    if S has RetractableTo Integer then
+
+      coerce : Fraction(Integer) -> %
+      coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::%
+
+      if not(S is Integer) then
+
+        retract : % -> Integer
+        retract(x:%):Integer == retract(retract(x)@S)
+
+        retractIfCan : % -> Union(Integer,"failed")
+        retractIfCan(x:%):Union(Integer, "failed") ==
+          (u := retractIfCan(x)@Union(S, "failed")) case "failed" =>
+            "failed"
+          retractIfCan(u::S)
+
+    if S has IntegerNumberSystem then
+
+      random : () -> %
+      random():% ==
+        while zero?(d:=random()$S) repeat d
+        random()$S / d
+
+    reducedSystem : (Matrix(%),Vector(%)) ->
+       Record(mat: Matrix(S),vec: Vector(S))
+    reducedSystem(m:Matrix %, v:Vector %):
+      Record(mat:Matrix S, vec:Vector S) ==
+        n := reducedSystem(horizConcat(v::Matrix(%), m))@Matrix(S)
+        [subMatrix(n, minRowIndex n, maxRowIndex n, 1 + minColIndex n,
+                                maxColIndex n), column(n, minColIndex n)]
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{QFCAT.dotabb}
+"QFCAT"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=QFCAT"];
+"QFCAT" -> "ALGEBRA"
+"QFCAT" -> "DIFEXT"
+"QFCAT" -> "FIELD"
+"QFCAT" -> "FEVALAB"
+"QFCAT" -> "FLINEXP"
+"QFCAT" -> "FPATMAB"
+"QFCAT" -> "PATAB"
+"QFCAT" -> "RETRACT"
+
+\end{chunk}
+\begin{chunk}{QFCAT.dotfull}
+"QuotientFieldCategory(a:IntegralDomain)"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=QFCAT"];
+"QuotientFieldCategory(a:IntegralDomain)" -> "Field()"
+"QuotientFieldCategory(a:IntegralDomain)" -> "Algebra(IntegralDomain)"
+"QuotientFieldCategory(a:IntegralDomain)" -> "RetractableTo(IntegralDomain)"
+"QuotientFieldCategory(a:IntegralDomain)" -> 
+  "FullyEvalableOver(IntegralDomain)"
+"QuotientFieldCategory(a:IntegralDomain)" ->
+  "DifferentialExtension(IntegralDomain)"
+"QuotientFieldCategory(a:IntegralDomain)" ->
+  "FullyLinearlyExplicitRingOver(IntegralDomain)"
+"QuotientFieldCategory(a:IntegralDomain)" ->
+  "Patternable(IntegralDomain)"
+"QuotientFieldCategory(a:IntegralDomain)" ->
+  "FullyPatternMatchable(IntegralDomain)"
+
+\end{chunk}
+\begin{chunk}{QFCAT.dotpic}
+digraph pic {
+ fontsize=10;
+ bgcolor="#ECEA81";
+ node [shape=box, color=white, style=filled];
+
+"QuotientFieldCategory(a:IntegralDomain)" [color=lightblue];
+"QuotientFieldCategory(a:IntegralDomain)" -> "ALGEBRA..."
+"QuotientFieldCategory(a:IntegralDomain)" -> "DIFEXT..."
+"QuotientFieldCategory(a:IntegralDomain)" -> "FIELD..."
+"QuotientFieldCategory(a:IntegralDomain)" -> "FEVALAB..."
+"QuotientFieldCategory(a:IntegralDomain)" -> "FLINEXP..."
+"QuotientFieldCategory(a:IntegralDomain)" -> "FPATMAB..."
+"QuotientFieldCategory(a:IntegralDomain)" -> "PATAB..."
+"QuotientFieldCategory(a:IntegralDomain)" -> "RETRACT..."
+
+"ALGEBRA..." [color=lightblue];
+"DIFEXT..." [color=lightblue];
+"FIELD..." [color=lightblue];
+"FEVALAB..." [color=lightblue];
+"FLINEXP..." [color=lightblue];
+"FPATMAB..." [color=lightblue];
+"PATAB..." [color=lightblue];
+"RETRACT..." [color=lightblue];
+
+}
+
+\end{chunk}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\pagehead{RealClosedField}{RCFIELD}
+\pagepic{ps/v102realclosedfield.ps}{RCFIELD}{0.50}
+
+\begin{chunk}{RealClosedField.input}
 )set break resume
-)sys rm -f RecursivePolynomialCategory.output
-)spool RecursivePolynomialCategory.output
+)sys rm -f RealClosedField.output
+)spool RealClosedField.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show RecursivePolynomialCategory
+)show RealClosedField
 --R 
---R RecursivePolynomialCategory(R: Ring,E: OrderedAbelianMonoidSup,V: OrderedSet)  is a category constructor
---R Abbreviation for RecursivePolynomialCategory is RPOLCAT 
+--R RealClosedField  is a category constructor
+--R Abbreviation for RealClosedField is RCFIELD 
 --R This constructor is exposed in this frame.
---R Issue )edit bookvol10.2.pamphlet to see algebra source code for RPOLCAT 
+--R Issue )edit bookvol10.2.pamphlet to see algebra source code for RCFIELD 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
+--R ?*? : (%,Fraction(Integer)) -> %      ?*? : (Fraction(Integer),%) -> %
+--R ?*? : (%,Integer) -> %                ?*? : (Integer,%) -> %
+--R ?*? : (%,Fraction(Integer)) -> %      ?*? : (Fraction(Integer),%) -> %
 --R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
 --R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?**? : (%,Fraction(Integer)) -> %     ?**? : (%,Integer) -> %
 --R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
 --R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
---R -? : % -> %                           ?/? : (%,R) -> % if R has FIELD
---R ?=? : (%,%) -> Boolean                D : (%,V,NonNegativeInteger) -> %
---R D : (%,List(V)) -> %                  D : (%,V) -> %
---R 1 : () -> %                           0 : () -> %
+--R -? : % -> %                           ?/? : (%,%) -> %
+--R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
+--R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
+--R ?>=? : (%,%) -> Boolean               1 : () -> %
+--R 0 : () -> %                           ?^? : (%,Integer) -> %
 --R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R coefficient : (%,E) -> R              coefficients : % -> List(R)
---R coerce : % -> % if R has INTDOM       coerce : V -> %
---R coerce : R -> %                       coerce : Integer -> %
---R coerce : % -> OutputForm              content : % -> R if R has GCDDOM
---R deepestInitial : % -> %               deepestTail : % -> %
---R degree : % -> E                       differentiate : (%,List(V)) -> %
---R differentiate : (%,V) -> %            eval : (%,List(V),List(%)) -> %
---R eval : (%,V,%) -> %                   eval : (%,List(V),List(R)) -> %
---R eval : (%,V,R) -> %                   eval : (%,List(%),List(%)) -> %
---R eval : (%,%,%) -> %                   eval : (%,Equation(%)) -> %
---R eval : (%,List(Equation(%))) -> %     gcd : (%,%) -> % if R has GCDDOM
---R gcd : List(%) -> % if R has GCDDOM    gcd : (R,%) -> R if R has GCDDOM
---R ground : % -> R                       ground? : % -> Boolean
---R hash : % -> SingleInteger             head : % -> %
---R headReduce : (%,%) -> %               headReduced? : (%,%) -> Boolean
---R infRittWu? : (%,%) -> Boolean         init : % -> %
---R initiallyReduce : (%,%) -> %          iteratedInitials : % -> List(%)
---R latex : % -> String                   lazyPquo : (%,%,V) -> %
---R lazyPquo : (%,%) -> %                 lazyPrem : (%,%,V) -> %
---R lazyPrem : (%,%) -> %                 lcm : (%,%) -> % if R has GCDDOM
---R lcm : List(%) -> % if R has GCDDOM    leadingCoefficient : (%,V) -> %
---R leadingCoefficient : % -> R           leadingMonomial : % -> %
---R leastMonomial : % -> %                mainCoefficients : % -> List(%)
---R mainMonomial : % -> %                 mainMonomials : % -> List(%)
---R map : ((R -> R),%) -> %               mapExponents : ((E -> E),%) -> %
---R max : (%,%) -> % if R has ORDSET      mdeg : % -> NonNegativeInteger
---R min : (%,%) -> % if R has ORDSET      minimumDegree : % -> E
---R monic? : % -> Boolean                 monicModulo : (%,%) -> %
---R monomial : (R,E) -> %                 monomial? : % -> Boolean
---R monomials : % -> List(%)              mvar : % -> V
---R normalized? : (%,%) -> Boolean        one? : % -> Boolean
---R pomopo! : (%,R,E,%) -> %              pquo : (%,%,V) -> %
---R pquo : (%,%) -> %                     prem : (%,%,V) -> %
---R prem : (%,%) -> %                     primitiveMonomials : % -> List(%)
---R quasiMonic? : % -> Boolean            recip : % -> Union(%,"failed")
---R reduced? : (%,List(%)) -> Boolean     reduced? : (%,%) -> Boolean
---R reductum : (%,V) -> %                 reductum : % -> %
---R retract : % -> V                      retract : % -> R
---R sample : () -> %                      supRittWu? : (%,%) -> Boolean
---R tail : % -> %                         variables : % -> List(V)
---R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
---R ?*? : (Fraction(Integer),%) -> % if R has ALGEBRA(FRAC(INT))
---R ?*? : (%,Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT))
---R ?<? : (%,%) -> Boolean if R has ORDSET
---R ?<=? : (%,%) -> Boolean if R has ORDSET
---R ?>? : (%,%) -> Boolean if R has ORDSET
---R ?>=? : (%,%) -> Boolean if R has ORDSET
---R D : (%,List(V),List(NonNegativeInteger)) -> %
---R LazardQuotient : (%,%,NonNegativeInteger) -> % if R has INTDOM
---R LazardQuotient2 : (%,%,%,NonNegativeInteger) -> % if R has INTDOM
---R RittWuCompare : (%,%) -> Union(Boolean,"failed")
---R associates? : (%,%) -> Boolean if R has INTDOM
---R binomThmExpt : (%,%,NonNegativeInteger) -> % if R has COMRING
+--R abs : % -> %                          associates? : (%,%) -> Boolean
+--R coerce : Fraction(Integer) -> %       coerce : Integer -> %
+--R coerce : Fraction(Integer) -> %       coerce : % -> %
+--R coerce : Fraction(Integer) -> %       coerce : Integer -> %
+--R coerce : % -> OutputForm              factor : % -> Factored(%)
+--R gcd : (%,%) -> %                      gcd : List(%) -> %
+--R hash : % -> SingleInteger             inv : % -> %
+--R latex : % -> String                   lcm : (%,%) -> %
+--R lcm : List(%) -> %                    max : (%,%) -> %
+--R min : (%,%) -> %                      negative? : % -> Boolean
+--R nthRoot : (%,Integer) -> %            one? : % -> Boolean
+--R positive? : % -> Boolean              prime? : % -> Boolean
+--R ?quo? : (%,%) -> %                    recip : % -> Union(%,"failed")
+--R ?rem? : (%,%) -> %                    rename : (%,OutputForm) -> %
+--R rename! : (%,OutputForm) -> %         retract : % -> Fraction(Integer)
+--R sample : () -> %                      sign : % -> Integer
+--R sizeLess? : (%,%) -> Boolean          sqrt : Integer -> %
+--R sqrt : Fraction(Integer) -> %         sqrt : (%,NonNegativeInteger) -> %
+--R sqrt : % -> %                         squareFree : % -> Factored(%)
+--R squareFreePart : % -> %               unit? : % -> Boolean
+--R unitCanonical : % -> %                zero? : % -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R allRootsOf : Polynomial(Integer) -> List(%)
+--R allRootsOf : Polynomial(Fraction(Integer)) -> List(%)
+--R allRootsOf : Polynomial(%) -> List(%)
+--R allRootsOf : SparseUnivariatePolynomial(Integer) -> List(%)
+--R allRootsOf : SparseUnivariatePolynomial(Fraction(Integer)) -> List(%)
+--R allRootsOf : SparseUnivariatePolynomial(%) -> List(%)
+--R approximate : (%,%) -> Fraction(Integer)
 --R characteristic : () -> NonNegativeInteger
---R charthRoot : % -> Union(%,"failed") if and(has($,CharacteristicNonZero),has(R,PolynomialFactorizationExplicit)) or R has CHARNZ
---R coefficient : (%,List(V),List(NonNegativeInteger)) -> %
---R coefficient : (%,V,NonNegativeInteger) -> %
---R coerce : Fraction(Integer) -> % if R has RETRACT(FRAC(INT)) or R has ALGEBRA(FRAC(INT))
---R coerce : % -> Polynomial(R) if V has KONVERT(SYMBOL)
---R conditionP : Matrix(%) -> Union(Vector(%),"failed") if and(has($,CharacteristicNonZero),has(R,PolynomialFactorizationExplicit))
---R content : (%,V) -> % if R has GCDDOM
---R convert : % -> Polynomial(R) if V has KONVERT(SYMBOL)
---R convert : % -> String if R has RETRACT(INT) and V has KONVERT(SYMBOL)
---R convert : Polynomial(R) -> % if V has KONVERT(SYMBOL)
---R convert : Polynomial(Integer) -> % if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
---R convert : Polynomial(Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
---R convert : % -> InputForm if V has KONVERT(INFORM) and R has KONVERT(INFORM)
---R convert : % -> Pattern(Integer) if V has KONVERT(PATTERN(INT)) and R has KONVERT(PATTERN(INT))
---R convert : % -> Pattern(Float) if V has KONVERT(PATTERN(FLOAT)) and R has KONVERT(PATTERN(FLOAT))
---R degree : (%,List(V)) -> List(NonNegativeInteger)
---R degree : (%,V) -> NonNegativeInteger
---R differentiate : (%,List(V),List(NonNegativeInteger)) -> %
---R differentiate : (%,V,NonNegativeInteger) -> %
---R discriminant : (%,V) -> % if R has COMRING
---R exactQuotient : (%,%) -> % if R has INTDOM
---R exactQuotient : (%,R) -> % if R has INTDOM
---R exactQuotient! : (%,%) -> % if R has INTDOM
---R exactQuotient! : (%,R) -> % if R has INTDOM
---R exquo : (%,%) -> Union(%,"failed") if R has INTDOM
---R exquo : (%,R) -> Union(%,"failed") if R has INTDOM
---R extendedSubResultantGcd : (%,%) -> Record(gcd: %,coef1: %,coef2: %) if R has INTDOM
---R factor : % -> Factored(%) if R has PFECAT
---R factorPolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT
---R factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT
---R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) if R has GCDDOM
---R halfExtendedSubResultantGcd1 : (%,%) -> Record(gcd: %,coef1: %) if R has INTDOM
---R halfExtendedSubResultantGcd2 : (%,%) -> Record(gcd: %,coef2: %) if R has INTDOM
---R headReduced? : (%,List(%)) -> Boolean
---R initiallyReduced? : (%,List(%)) -> Boolean
---R initiallyReduced? : (%,%) -> Boolean
---R isExpt : % -> Union(Record(var: V,exponent: NonNegativeInteger),"failed")
---R isPlus : % -> Union(List(%),"failed")
---R isTimes : % -> Union(List(%),"failed")
---R lastSubResultant : (%,%) -> % if R has INTDOM
---R lazyPremWithDefault : (%,%,V) -> Record(coef: %,gap: NonNegativeInteger,remainder: %)
---R lazyPremWithDefault : (%,%) -> Record(coef: %,gap: NonNegativeInteger,remainder: %)
---R lazyPseudoDivide : (%,%,V) -> Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %)
---R lazyPseudoDivide : (%,%) -> Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %)
---R lazyResidueClass : (%,%) -> Record(polnum: %,polden: %,power: NonNegativeInteger)
---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) if R has GCDDOM
---R mainContent : % -> % if R has GCDDOM
---R mainPrimitivePart : % -> % if R has GCDDOM
---R mainSquareFreePart : % -> % if R has GCDDOM
---R mainVariable : % -> Union(V,"failed")
---R minimumDegree : (%,List(V)) -> List(NonNegativeInteger)
---R minimumDegree : (%,V) -> NonNegativeInteger
---R monicDivide : (%,%,V) -> Record(quotient: %,remainder: %)
---R monomial : (%,List(V),List(NonNegativeInteger)) -> %
---R monomial : (%,V,NonNegativeInteger) -> %
---R multivariate : (SparseUnivariatePolynomial(%),V) -> %
---R multivariate : (SparseUnivariatePolynomial(R),V) -> %
---R nextsubResultant2 : (%,%,%,%) -> % if R has INTDOM
---R normalized? : (%,List(%)) -> Boolean
---R numberOfMonomials : % -> NonNegativeInteger
---R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if V has PATMAB(INT) and R has PATMAB(INT)
---R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if V has PATMAB(FLOAT) and R has PATMAB(FLOAT)
---R primPartElseUnitCanonical : % -> % if R has INTDOM
---R primPartElseUnitCanonical! : % -> % if R has INTDOM
---R prime? : % -> Boolean if R has PFECAT
---R primitivePart : (%,V) -> % if R has GCDDOM
---R primitivePart : % -> % if R has GCDDOM
---R primitivePart! : % -> % if R has GCDDOM
---R pseudoDivide : (%,%) -> Record(quotient: %,remainder: %)
---R reducedSystem : Matrix(%) -> Matrix(R)
---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(R),vec: Vector(R))
---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if R has LINEXP(INT)
---R reducedSystem : Matrix(%) -> Matrix(Integer) if R has LINEXP(INT)
---R resultant : (%,%) -> % if R has INTDOM
---R resultant : (%,%,V) -> % if R has COMRING
---R retract : Polynomial(R) -> % if not(has(R,Algebra(Fraction(Integer)))) and not(has(R,Algebra(Integer))) and V has KONVERT(SYMBOL) or not(has(R,IntegerNumberSystem)) and not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or not(has(R,QuotientFieldCategory(Integer))) and R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
---R retract : Polynomial(Integer) -> % if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
---R retract : Polynomial(Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
---R retract : % -> Integer if R has RETRACT(INT)
---R retract : % -> Fraction(Integer) if R has RETRACT(FRAC(INT))
---R retractIfCan : Polynomial(R) -> Union(%,"failed") if not(has(R,Algebra(Fraction(Integer)))) and not(has(R,Algebra(Integer))) and V has KONVERT(SYMBOL) or not(has(R,IntegerNumberSystem)) and not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or not(has(R,QuotientFieldCategory(Integer))) and R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
---R retractIfCan : Polynomial(Integer) -> Union(%,"failed") if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
---R retractIfCan : Polynomial(Fraction(Integer)) -> Union(%,"failed") if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
---R retractIfCan : % -> Union(V,"failed")
---R retractIfCan : % -> Union(Integer,"failed") if R has RETRACT(INT)
---R retractIfCan : % -> Union(Fraction(Integer),"failed") if R has RETRACT(FRAC(INT))
---R retractIfCan : % -> Union(R,"failed")
---R solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> Union(List(SparseUnivariatePolynomial(%)),"failed") if R has PFECAT
---R squareFree : % -> Factored(%) if R has GCDDOM
---R squareFreePart : % -> % if R has GCDDOM
---R squareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT
---R subResultantChain : (%,%) -> List(%) if R has INTDOM
---R subResultantGcd : (%,%) -> % if R has INTDOM
+--R divide : (%,%) -> Record(quotient: %,remainder: %)
+--R euclideanSize : % -> NonNegativeInteger
+--R expressIdealMember : (List(%),%) -> Union(List(%),"failed")
+--R exquo : (%,%) -> Union(%,"failed")
+--R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
+--R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
+--R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
+--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
+--R mainDefiningPolynomial : % -> Union(SparseUnivariatePolynomial(%),"failed")
+--R mainForm : % -> Union(OutputForm,"failed")
+--R mainValue : % -> Union(SparseUnivariatePolynomial(%),"failed")
+--R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
+--R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
+--R retract : % -> Fraction(Integer) if Fraction(Integer) has RETRACT(FRAC(INT))
+--R retract : % -> Integer if Fraction(Integer) has RETRACT(INT)
+--R retractIfCan : % -> Union(Fraction(Integer),"failed")
+--R retractIfCan : % -> Union(Fraction(Integer),"failed") if Fraction(Integer) has RETRACT(FRAC(INT))
+--R retractIfCan : % -> Union(Integer,"failed") if Fraction(Integer) has RETRACT(INT)
+--R rootOf : (SparseUnivariatePolynomial(%),PositiveInteger) -> Union(%,"failed")
+--R rootOf : (SparseUnivariatePolynomial(%),PositiveInteger,OutputForm) -> Union(%,"failed")
 --R subtractIfCan : (%,%) -> Union(%,"failed")
---R totalDegree : (%,List(V)) -> NonNegativeInteger
---R totalDegree : % -> NonNegativeInteger
---R unit? : % -> Boolean if R has INTDOM
---R unitCanonical : % -> % if R has INTDOM
---R unitNormal : % -> Record(unit: %,canonical: %,associate: %) if R has INTDOM
---R univariate : % -> SparseUnivariatePolynomial(R)
---R univariate : (%,V) -> SparseUnivariatePolynomial(%)
+--R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{RecursivePolynomialCategory.help}
+
+\begin{chunk}{RealClosedField.help}
 ====================================================================
-RecursivePolynomialCategory examples
+RealClosedField examples
 ====================================================================
 
-A category for general multi-variate polynomials with coefficients 
-in a ring, variables in an ordered set, and exponents from an 
-ordered abelian monoid, with a sup operation.
-
-When not constant, such a polynomial is viewed as a univariate polynomial 
-in its main variable w. r. t. to the total ordering on the elements in 
-the ordered set, so that some operations usually defined for univariate 
-polynomials make sense here.
+RealClosedField provides common access functions for all real closed fields.
+It provides computations with generic real roots of polynomials.
 
 See Also:
-o )show RecursivePolynomialCategory
+o )show RealClosedField
 
 \end{chunk}
 {\bf See:}
 
-\pagefrom{PolynomialCategory}{POLYCAT}
+\pagefrom{Algebra}{ALGEBRA}
+\pagefrom{CharacteristicZero}{CHARZ}
+\pagefrom{CommutativeRing}{COMRING}
+\pagefrom{Field}{FIELD}
+\pagefrom{FullyRetractableTo}{FRETRCT}
+\pagefrom{OrderedRing}{ORDRING}
+\pagefrom{RadicalCategory}{RADCAT}
 
 {\bf Exports:}\\
 
-\begin{tabular}{lll}
-\cross{RPOLCAT}{0} &
-\cross{RPOLCAT}{1} &
-\cross{RPOLCAT}{associates?} \\
-\cross{RPOLCAT}{binomThmExpt} &
-\cross{RPOLCAT}{characteristic} &
-\cross{RPOLCAT}{charthRoot} \\
-\cross{RPOLCAT}{coefficient} &
-\cross{RPOLCAT}{coefficients} &
-\cross{RPOLCAT}{coerce} \\
-\cross{RPOLCAT}{conditionP} &
-\cross{RPOLCAT}{convert} &
-\cross{RPOLCAT}{D} \\
-\cross{RPOLCAT}{deepestInitial} &
-\cross{RPOLCAT}{deepestTail} &
-\cross{RPOLCAT}{degree} \\
-\cross{RPOLCAT}{differentiate} &
-\cross{RPOLCAT}{discriminant} &
-\cross{RPOLCAT}{eval} \\
-\cross{RPOLCAT}{exactQuotient} &
-\cross{RPOLCAT}{exactQuotient!} &
-\cross{RPOLCAT}{exquo} \\
-\cross{RPOLCAT}{extendedSubResultantGcd} &
-\cross{RPOLCAT}{factor} &
-\cross{RPOLCAT}{factorPolynomial} \\
-\cross{RPOLCAT}{factorSquareFreePolynomial} &
-\cross{RPOLCAT}{gcd} &
-\cross{RPOLCAT}{gcdPolynomial} \\
-\cross{RPOLCAT}{ground} &
-\cross{RPOLCAT}{ground?} &
-\cross{RPOLCAT}{halfExtendedSubResultantGcd1} \\
-\cross{RPOLCAT}{halfExtendedSubResultantGcd2} &
-\cross{RPOLCAT}{hash} &
-\cross{RPOLCAT}{head} \\
-\cross{RPOLCAT}{headReduce} &
-\cross{RPOLCAT}{headReduced?} &
-\cross{RPOLCAT}{infRittWu?} \\
-\cross{RPOLCAT}{init} &
-\cross{RPOLCAT}{initiallyReduce} &
-\cross{RPOLCAT}{initiallyReduced?} \\
-\cross{RPOLCAT}{isExpt} &
-\cross{RPOLCAT}{isPlus} &
-\cross{RPOLCAT}{isTimes} \\
-\cross{RPOLCAT}{iteratedInitials} &
-\cross{RPOLCAT}{lastSubResultant} &
-\cross{RPOLCAT}{latex} \\
-\cross{RPOLCAT}{LazardQuotient} &
-\cross{RPOLCAT}{LazardQuotient2} &
-\cross{RPOLCAT}{lazyPquo} \\
-\cross{RPOLCAT}{lazyPrem} &
-\cross{RPOLCAT}{lazyPremWithDefault} &
-\cross{RPOLCAT}{lazyPseudoDivide} \\
-\cross{RPOLCAT}{lazyResidueClass} &
-\cross{RPOLCAT}{lcm} &
-\cross{RPOLCAT}{leadingCoefficient} \\
-\cross{RPOLCAT}{leadingMonomial} &
-\cross{RPOLCAT}{leastMonomial} &
-\cross{RPOLCAT}{mainCoefficients} \\
-\cross{RPOLCAT}{mainContent} &
-\cross{RPOLCAT}{mainMonomial} &
-\cross{RPOLCAT}{mainPrimitivePart} \\
-\cross{RPOLCAT}{mainSquareFreePart} &
-\cross{RPOLCAT}{mainVariable} &
-\cross{RPOLCAT}{map} \\
-\cross{RPOLCAT}{mapExponents} &
-\cross{RPOLCAT}{max} &
-\cross{RPOLCAT}{mdeg} \\
-\cross{RPOLCAT}{min} &
-\cross{RPOLCAT}{minimumDegree} &
-\cross{RPOLCAT}{monic?} \\
-\cross{RPOLCAT}{monicDivide} &
-\cross{RPOLCAT}{monicModulo} &
-\cross{RPOLCAT}{monomial} \\
-\cross{RPOLCAT}{monomial?} &
-\cross{RPOLCAT}{monomials} &
-\cross{RPOLCAT}{multivariate} \\
-\cross{RPOLCAT}{mvar} &
-\cross{RPOLCAT}{nextsubResultant2} &
-\cross{RPOLCAT}{normalized?} \\
-\cross{RPOLCAT}{numberOfMonomials} &
-\cross{RPOLCAT}{one?} &
-\cross{RPOLCAT}{patternMatch} \\
-\cross{RPOLCAT}{pomopo!} &
-\cross{RPOLCAT}{pquo} &
-\cross{RPOLCAT}{prem} \\
-\cross{RPOLCAT}{primPartElseUnitCanonical} &
-\cross{RPOLCAT}{primPartElseUnitCanonical!} &
-\cross{RPOLCAT}{prime?} \\
-\cross{RPOLCAT}{primitiveMonomials} &
-\cross{RPOLCAT}{primitivePart} &
-\cross{RPOLCAT}{primitivePart!} \\
-\cross{RPOLCAT}{pseudoDivide} &
-\cross{RPOLCAT}{quasiMonic?} &
-\cross{RPOLCAT}{recip} \\
-\cross{RPOLCAT}{reduced?} &
-\cross{RPOLCAT}{reducedSystem} &
-\cross{RPOLCAT}{reductum} \\
-\cross{RPOLCAT}{resultant} &
-\cross{RPOLCAT}{retract} &
-\cross{RPOLCAT}{retractIfCan} \\
-\cross{RPOLCAT}{RittWuCompare} &
-\cross{RPOLCAT}{sample} &
-\cross{RPOLCAT}{solveLinearPolynomialEquation} \\
-\cross{RPOLCAT}{squareFree} &
-\cross{RPOLCAT}{squareFreePart} &
-\cross{RPOLCAT}{squareFreePolynomial} \\
-\cross{RPOLCAT}{subResultantChain} &
-\cross{RPOLCAT}{subResultantGcd} &
-\cross{RPOLCAT}{subtractIfCan} \\
-\cross{RPOLCAT}{supRittWu?} &
-\cross{RPOLCAT}{tail} &
-\cross{RPOLCAT}{totalDegree} \\
-\cross{RPOLCAT}{unit?} &
-\cross{RPOLCAT}{unitCanonical} &
-\cross{RPOLCAT}{unitNormal} \\
-\cross{RPOLCAT}{univariate} &
-\cross{RPOLCAT}{variables} &
-\cross{RPOLCAT}{zero?} \\
-\cross{RPOLCAT}{?*?} &
-\cross{RPOLCAT}{?**?} &
-\cross{RPOLCAT}{?+?} \\
-\cross{RPOLCAT}{?-?} &
-\cross{RPOLCAT}{-?} &
-\cross{RPOLCAT}{?=?} \\
-\cross{RPOLCAT}{?\^{}?} &
-\cross{RPOLCAT}{?\~{}=?} &
-\cross{RPOLCAT}{?/?} \\
-\cross{RPOLCAT}{?$<$?} &
-\cross{RPOLCAT}{?$<=$?} &
-\cross{RPOLCAT}{?$>$?} \\
-\cross{RPOLCAT}{?$>=$?} &&
+\begin{tabular}{llll}
+\cross{RCFIELD}{0} &
+\cross{RCFIELD}{1} &
+\cross{RCFIELD}{abs} &
+\cross{RCFIELD}{allRootsOf} \\
+\cross{RCFIELD}{approximate} &
+\cross{RCFIELD}{associates?} &
+\cross{RCFIELD}{characteristic} &
+\cross{RCFIELD}{coerce} \\
+\cross{RCFIELD}{divide} &
+\cross{RCFIELD}{euclideanSize} &
+\cross{RCFIELD}{expressIdealMember} &
+\cross{RCFIELD}{exquo} \\
+\cross{RCFIELD}{extendedEuclidean} &
+\cross{RCFIELD}{factor} &
+\cross{RCFIELD}{gcd} &
+\cross{RCFIELD}{gcdPolynomial} \\
+\cross{RCFIELD}{hash} &
+\cross{RCFIELD}{inv} &
+\cross{RCFIELD}{latex} &
+\cross{RCFIELD}{lcm} \\
+\cross{RCFIELD}{mainDefiningPolynomial} &
+\cross{RCFIELD}{mainForm} &
+\cross{RCFIELD}{mainValue} &
+\cross{RCFIELD}{max} \\
+\cross{RCFIELD}{min} &
+\cross{RCFIELD}{multiEuclidean} &
+\cross{RCFIELD}{negative?} &
+\cross{RCFIELD}{nthRoot} \\
+\cross{RCFIELD}{one?} &
+\cross{RCFIELD}{positive?} &
+\cross{RCFIELD}{prime?} &
+\cross{RCFIELD}{principalIdeal} \\
+\cross{RCFIELD}{recip} &
+\cross{RCFIELD}{rename} &
+\cross{RCFIELD}{rename!} &
+\cross{RCFIELD}{retract} \\
+\cross{RCFIELD}{retractIfCan} &
+\cross{RCFIELD}{rootOf} &
+\cross{RCFIELD}{sample} &
+\cross{RCFIELD}{sign} \\
+\cross{RCFIELD}{sizeLess?} &
+\cross{RCFIELD}{sqrt} &
+\cross{RCFIELD}{squareFree} &
+\cross{RCFIELD}{squareFreePart} \\
+\cross{RCFIELD}{subtractIfCan} &
+\cross{RCFIELD}{unit?} &
+\cross{RCFIELD}{unitCanonical} &
+\cross{RCFIELD}{unitNormal} \\
+\cross{RCFIELD}{zero?} &
+\cross{RCFIELD}{?*?} &
+\cross{RCFIELD}{?**?} &
+\cross{RCFIELD}{?+?} \\
+\cross{RCFIELD}{?-?} &
+\cross{RCFIELD}{-?} &
+\cross{RCFIELD}{?/?} &
+\cross{RCFIELD}{?$<$?} \\
+\cross{RCFIELD}{?$<=$?} &
+\cross{RCFIELD}{?=?} &
+\cross{RCFIELD}{?$>$?} &
+\cross{RCFIELD}{?$>=$?} \\
+\cross{RCFIELD}{?\^{}?} &
+\cross{RCFIELD}{?\~{}=?} &
+\cross{RCFIELD}{?quo?} &
+\cross{RCFIELD}{?rem?} \\
 \end{tabular}
 
 {\bf Attributes Exported:}
 \begin{itemize}
-\item if \#1 has CommutativeRing then commutative(``*'') where
-{\bf \cross{RPOLCAT}{commutative(``*'')}}
-is true if it has an operation $"*": (D,D) -> D$
-which is commutative.
-\item if \#1 has IntegralDomain then noZeroDivisors where
-{\bf \cross{RPOLCAT}{noZeroDivisors}}
+\item {\bf \cross{RCFIELD}{noZeroDivisors}}
 is true if $x * y \ne 0$ implies both x and y are non-zero.
-\item if \#1 has canonicalUnitNormal then canonicalUnitNormal
-where {\bf \cross{RPOLCAT}{canonicalUnitNormal}}
+\item {\bf \cross{RCFIELD}{canonicalUnitNormal}}
 is true if we can choose a canonical representative for each class 
 of associate elements, that is {\tt associates?(a,b)} returns true 
 if and only if {\tt unitCanonical(a) = unitCanonical(b)}.
-\item {\bf \cross{RPOLCAT}{unitsKnown}}
+\item {\bf \cross{RCFIELD}{canonicalsClosed}}
+is true if\hfill\\
+{\tt unitCanonical(a)*unitCanonical(b) = unitCanonical(a*b)}.
+\item {\bf \cross{RCFIELD}{unitsKnown}}
 is true if a monoid (a multiplicative semigroup with a 1) has 
 unitsKnown means that  the operation {\tt recip} can only return 
 ``failed'' if its argument is not a unit.
-\item {\bf \cross{RPOLCAT}{leftUnitary}}
+\item {\bf \cross{RCFIELD}{leftUnitary}}
 is true if $1 * x = x$ for all x.
-\item {\bf \cross{RPOLCAT}{rightUnitary}}
+\item {\bf \cross{RCFIELD}{rightUnitary}}
 is true if $x * 1 = x$ for all x.
+\item {\bf \cross{RCFIELD}{commutative(``*'')}}
+is true if it has an operation $"*": (D,D) -> D$
+which is commutative.
 \end{itemize}
 
 These are directly exported but not implemented:
 \begin{verbatim}
- exactQuotient! : (%,R) -> % if R has INTDOM
- extendedSubResultantGcd : (%,%) -> Record(gcd: %,coef1: %,coef2: %) 
-   if R has INTDOM
- halfExtendedSubResultantGcd1 : (%,%) -> Record(gcd: %,coef1: %) 
-   if R has INTDOM
- halfExtendedSubResultantGcd2 : (%,%) -> Record(gcd: %,coef2: %) 
-   if R has INTDOM
- lastSubResultant : (%,%) -> % if R has INTDOM
- LazardQuotient : (%,%,NonNegativeInteger) -> %
-   if R has INTDOM
- LazardQuotient2 : (%,%,%,NonNegativeInteger) -> %
-   if R has INTDOM
- nextsubResultant2 : (%,%,%,%) -> % if R has INTDOM
- resultant : (%,%) -> % if R has INTDOM
- subResultantChain : (%,%) -> List % if R has INTDOM
- subResultantGcd : (%,%) -> % if R has INTDOM
+ allRootsOf : SparseUnivariatePolynomial % -> List %
+ approximate : (%,%) -> Fraction Integer
+ mainDefiningPolynomial :
+    % -> Union(SparseUnivariatePolynomial %,"failed")
+ mainForm : % -> Union(OutputForm,"failed")
+ mainValue : % -> Union(SparseUnivariatePolynomial %,"failed")
+ rename : (%,OutputForm) -> %         
+ rename! : (%,OutputForm) -> %
 \end{verbatim}
 
 These are implemented by this category:
 \begin{verbatim}
- coerce : % -> OutputForm             
- coerce : % -> Polynomial R if V has KONVERT SYMBOL
- convert : % -> String
-   if R has RETRACT INT 
-   and V has KONVERT SYMBOL
- convert : % -> Polynomial R if V has KONVERT SYMBOL
- convert : Polynomial R -> % if V has KONVERT SYMBOL
- convert : Polynomial Integer -> %
-   if not has(R,Algebra Fraction Integer) 
-   and R has ALGEBRA INT 
-   and V has KONVERT SYMBOL 
-   or R has ALGEBRA FRAC INT 
-   and V has KONVERT SYMBOL
- convert : Polynomial Fraction Integer -> %
-   if R has ALGEBRA FRAC INT 
-   and V has KONVERT SYMBOL
- deepestInitial : % -> %
- deepestTail : % -> %                 
- exactQuotient : (%,R) -> % if R has INTDOM
- exactQuotient : (%,%) -> % if R has INTDOM
- exactQuotient! : (%,%) -> % if R has INTDOM
- gcd : (R,%) -> R if R has GCDDOM
- head : % -> %
- headReduce : (%,%) -> %              
- headReduced? : (%,List %) -> Boolean
- headReduced? : (%,%) -> Boolean
- infRittWu? : (%,%) -> Boolean        
- init : % -> %
- initiallyReduce : (%,%) -> %         
- initiallyReduced? : (%,%) -> Boolean
- initiallyReduced? : (%,List %) -> Boolean
- iteratedInitials : % -> List %
- lazyPremWithDefault : (%,%) -> 
-   Record(coef: %,gap: NonNegativeInteger,remainder: %)
- lazyPremWithDefault : (%,%,V) -> 
-   Record(coef: %,gap: NonNegativeInteger,remainder: %)
- lazyPquo : (%,%) -> %                
- lazyPquo : (%,%,V) -> %
- lazyPrem : (%,%,V) -> %
- lazyPrem : (%,%) -> %                
- lazyPseudoDivide : (%,%) -> 
-   Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %)
- lazyPseudoDivide : (%,%,V) -> 
-   Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %)
- lazyResidueClass : (%,%) -> 
-   Record(polnum: %,polden: %,power: NonNegativeInteger)
- leadingCoefficient : (%,V) -> %
- leastMonomial : % -> %               
- mainCoefficients : % -> List %
- mainContent : % -> % if R has GCDDOM
- mainMonomial : % -> %                
- mainMonomials : % -> List %
- mainPrimitivePart : % -> % if R has GCDDOM
- mainSquareFreePart : % -> % if R has GCDDOM
- mdeg : % -> NonNegativeInteger       
- monic? : % -> Boolean                
- monicModulo : (%,%) -> %
- mvar : % -> V
- normalized? : (%,%) -> Boolean       
- normalized? : (%,List %) -> Boolean
- pquo : (%,%) -> %                    
- pquo : (%,%,V) -> %
- prem : (%,%,V) -> %
- prem : (%,%) -> %                    
- primitivePart! : % -> % if R has GCDDOM
- primPartElseUnitCanonical : % -> % if R has INTDOM
- primPartElseUnitCanonical! : % -> % if R has INTDOM
- pseudoDivide : (%,%) -> Record(quotient: %,remainder: %)
- quasiMonic? : % -> Boolean           
- reduced? : (%,%) -> Boolean
- reduced? : (%,List %) -> Boolean     
- reductum : (%,V) -> %                
- retract : Polynomial R -> %
-   if not has(R,Algebra Fraction Integer) 
-   and not has(R,Algebra Integer) 
-   and V has KONVERT SYMBOL 
-   or not has(R,IntegerNumberSystem) 
-   and not has(R,Algebra Fraction Integer) 
-   and R has ALGEBRA INT 
-   and V has KONVERT SYMBOL 
-   or not has(R,QuotientFieldCategory Integer) 
-   and R has ALGEBRA FRAC INT 
-   and V has KONVERT SYMBOL
- retract : Polynomial Integer -> %
-   if not has(R,Algebra Fraction Integer) 
-   and R has ALGEBRA INT 
-   and V has KONVERT SYMBOL 
-   or R has ALGEBRA FRAC INT 
-   and V has KONVERT SYMBOL
- retract : Polynomial Fraction Integer -> %
-   if R has ALGEBRA FRAC INT and V has KONVERT SYMBOL
- retractIfCan : Polynomial R -> Union(%,"failed")
-   if not has(R,Algebra Fraction Integer) 
-   and not has(R,Algebra Integer) 
-   and V has KONVERT SYMBOL 
-   or not has(R,IntegerNumberSystem) 
-   and not has(R,Algebra Fraction Integer) 
-   and R has ALGEBRA INT 
-   and V has KONVERT SYMBOL 
-   or not has(R,QuotientFieldCategory Integer) 
-   and R has ALGEBRA FRAC INT 
-   and V has KONVERT SYMBOL
- retractIfCan : Polynomial Fraction Integer -> Union(%,"failed")
-   if R has ALGEBRA FRAC INT 
-   and V has KONVERT SYMBOL
- retractIfCan : Polynomial Integer -> Union(%,"failed")
-   if not has(R,Algebra Fraction Integer) 
-   and R has ALGEBRA INT 
-   and V has KONVERT SYMBOL 
-   or R has ALGEBRA FRAC INT 
-   and V has KONVERT SYMBOL
- RittWuCompare : (%,%) -> Union(Boolean,"failed")
- supRittWu? : (%,%) -> Boolean
- tail : % -> %                        
+ allRootsOf : Polynomial Integer -> List %
+ allRootsOf : Polynomial Fraction Integer -> List %
+ allRootsOf : Polynomial % -> List %
+ allRootsOf : SparseUnivariatePolynomial Integer -> List %
+ allRootsOf : SparseUnivariatePolynomial Fraction Integer -> List %
+ characteristic : () -> NonNegativeInteger
+ nthRoot : (%,Integer) -> %
+ rootOf :
+   (SparseUnivariatePolynomial %,PositiveInteger) ->
+      Union(%,"failed")
+ rootOf :
+   (SparseUnivariatePolynomial %,PositiveInteger,OutputForm) ->
+      Union(%,"failed")
+ sqrt : (%,NonNegativeInteger) -> %
+ sqrt : Integer -> %                  
+ sqrt : Fraction Integer -> %
+ sqrt : % -> %                        
+ ?**? : (%,Fraction Integer) -> %
 \end{verbatim}
 
-These exports come from \refto{PolynomialCategory}(R,E,V)\hfill\\
-where R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet:
+These exports come from \refto{CharacteristicZero}():
 \begin{verbatim}
- 0 : () -> %
- 1 : () -> %                          
- associates? : (%,%) -> Boolean
-   if R has INTDOM
- binomThmExpt : (%,%,NonNegativeInteger) -> %
-   if R has COMRING
- characteristic : () -> NonNegativeInteger
- charthRoot : % -> Union(%,"failed")
-   if and(has($,CharacteristicNonZero),
-      has(R,PolynomialFactorizationExplicit)) 
-   or R has CHARNZ
- coefficient : (%,List V,List NonNegativeInteger) -> %
- coefficient : (%,V,NonNegativeInteger) -> %
- coefficient : (%,E) -> R
- coefficients : % -> List R           
- coerce : R -> %                      
+ 0 : () -> %                          
+ 1 : () -> %
+ coerce : Integer -> %                
+ coerce : % -> OutputForm
+ hash : % -> SingleInteger
+ latex : % -> String
+ one? : % -> Boolean                  
+ recip : % -> Union(%,"failed")       
+ sample : () -> %
+ subtractIfCan : (%,%) -> Union(%,"failed")
+ zero? : % -> Boolean
+ ?~=? : (%,%) -> Boolean              
+ ?^? : (%,NonNegativeInteger) -> %
+ ?^? : (%,PositiveInteger) -> %       
+ ?*? : (%,%) -> %                     
+ ?*? : (NonNegativeInteger,%) -> %
+ ?*? : (Integer,%) -> %
+ ?*? : (PositiveInteger,%) -> %       
+ ?**? : (%,PositiveInteger) -> %
+ ?**? : (%,NonNegativeInteger) -> %
+ ?+? : (%,%) -> %                     
+ ?-? : (%,%) -> %
+ -? : % -> %                          
+ ?=? : (%,%) -> Boolean               
+\end{verbatim}
+
+These exports come from \refto{OrderedRing}():
+\begin{verbatim}
+ abs : % -> %
+ coerce : Integer -> %                
+ max : (%,%) -> %                     
+ min : (%,%) -> %
+ negative? : % -> Boolean             
+ positive? : % -> Boolean
+ sign : % -> Integer                  
+ ?<? : (%,%) -> Boolean               
+ ?<=? : (%,%) -> Boolean
+ ?>? : (%,%) -> Boolean
+ ?>=? : (%,%) -> Boolean              
+ ?*? : (Integer,%) -> %
+\end{verbatim}
+
+These exports come from \refto{Field}():
+\begin{verbatim}
+ associates? : (%,%) -> Boolean       
+ coerce : % -> %                      
  coerce : Fraction Integer -> %
-   if R has RETRACT FRAC INT or R has ALGEBRA FRAC INT
- coerce : V -> %
- coerce : % -> % if R has INTDOM
- coerce : Integer -> %
- conditionP : Matrix % -> Union(Vector %,"failed")
-   if and(has($,CharacteristicNonZero),
-          has(R,PolynomialFactorizationExplicit))
- content : % -> R if R has GCDDOM
- content : (%,V) -> % if R has GCDDOM
- convert : % -> Pattern Integer
-   if V has KONVERT PATTERN INT and R has KONVERT PATTERN INT
- convert : % -> Pattern Float
-   if V has KONVERT PATTERN FLOAT and R has KONVERT PATTERN FLOAT
- convert : % -> InputForm
-   if V has KONVERT INFORM and R has KONVERT INFORM
- D : (%,List V) -> %                  
- D : (%,V) -> %
- D : (%,List V,List NonNegativeInteger) -> %
- D : (%,V,NonNegativeInteger) -> %
- degree : % -> E
- degree : (%,List V) -> List NonNegativeInteger
- degree : (%,V) -> NonNegativeInteger
- differentiate : (%,List V,List NonNegativeInteger) -> %
- differentiate : (%,V,NonNegativeInteger) -> %
- differentiate : (%,List V) -> %      
- differentiate : (%,V) -> %
- discriminant : (%,V) -> % if R has COMRING
- eval : (%,List Equation %) -> %
- eval : (%,Equation %) -> %           
- eval : (%,List %,List %) -> %        
- eval : (%,%,%) -> %
- eval : (%,V,R) -> %
- eval : (%,List V,List R) -> %        
- eval : (%,V,%) -> %
- eval : (%,List V,List %) -> %        
- exquo : (%,R) -> Union(%,"failed") if R has INTDOM
- exquo : (%,%) -> Union(%,"failed") if R has INTDOM
- factor : % -> Factored % if R has PFECAT
- factorPolynomial : 
-   SparseUnivariatePolynomial % -> 
-     Factored SparseUnivariatePolynomial %
-      if R has PFECAT
- factorSquareFreePolynomial : 
-   SparseUnivariatePolynomial % -> 
-     Factored SparseUnivariatePolynomial %
-       if R has PFECAT
- gcd : (%,%) -> % if R has GCDDOM
- gcd : List % -> % if R has GCDDOM
- gcdPolynomial : 
+ coerce : Fraction Integer -> %
+ coerce : Fraction Integer -> %
+ divide : (%,%) -> Record(quotient: %,remainder: %)
+ euclideanSize : % -> NonNegativeInteger
+ expressIdealMember : (List %,%) -> Union(List %,"failed")
+ exquo : (%,%) -> Union(%,"failed")
+ extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
+ extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
+ factor : % -> Factored %             
+ gcd : (%,%) -> %
+ gcd : List % -> %                    
+ gcdPolynomial :
    (SparseUnivariatePolynomial %,
-    SparseUnivariatePolynomial %) -> 
-      SparseUnivariatePolynomial %
-        if R has GCDDOM
- ground : % -> R                      
- ground? : % -> Boolean
- hash : % -> SingleInteger            
- isExpt : % -> Union(Record(var: V,exponent: NonNegativeInteger),"failed")
- isPlus : % -> Union(List %,"failed")
- isTimes : % -> Union(List %,"failed")
- latex : % -> String                  
- lcm : (%,%) -> % if R has GCDDOM
- lcm : List % -> % if R has GCDDOM
- leadingCoefficient : % -> R          
- leadingMonomial : % -> %
- mainVariable : % -> Union(V,"failed")
- map : ((R -> R),%) -> %              
- mapExponents : ((E -> E),%) -> %
- max : (%,%) -> % if R has ORDSET
- min : (%,%) -> % if R has ORDSET
- minimumDegree : % -> E
- minimumDegree : (%,List V) -> List NonNegativeInteger
- minimumDegree : (%,V) -> NonNegativeInteger
- monicDivide : (%,%,V) -> Record(quotient: %,remainder: %)
- monomial : (%,V,NonNegativeInteger) -> %
- monomial : (%,List V,List NonNegativeInteger) -> %
- monomial : (R,E) -> %                
- monomial? : % -> Boolean
- monomials : % -> List %              
- multivariate : (SparseUnivariatePolynomial %,V) -> %
- multivariate : (SparseUnivariatePolynomial R,V) -> %
- numberOfMonomials : % -> NonNegativeInteger
- one? : % -> Boolean
- patternMatch : 
-   (%,Pattern Integer,PatternMatchResult(Integer,%)) -> 
-     PatternMatchResult(Integer,%)
-       if V has PATMAB INT and R has PATMAB INT
- patternMatch : 
-   (%,Pattern Float,PatternMatchResult(Float,%)) -> 
-     PatternMatchResult(Float,%)
-      if V has PATMAB FLOAT and R has PATMAB FLOAT
- pomopo! : (%,R,E,%) -> %             
- prime? : % -> Boolean if R has PFECAT
- primitiveMonomials : % -> List %
- primitivePart : (%,V) -> % if R has GCDDOM
- primitivePart : % -> % if R has GCDDOM
- recip : % -> Union(%,"failed")
- reducedSystem : Matrix % -> Matrix R
- reducedSystem : (Matrix %,Vector %) ->
-    Record(mat: Matrix R,vec: Vector R)
- reducedSystem : (Matrix %,Vector %) ->
-   Record(mat: Matrix Integer,vec: Vector Integer)
-     if R has LINEXP INT
- reducedSystem : Matrix % -> Matrix Integer
-   if R has LINEXP INT
- reductum : % -> %
- resultant : (%,%,V) -> % if R has COMRING
- retract : % -> R
- retract : % -> Integer if R has RETRACT INT
- retract : % -> Fraction Integer
-   if R has RETRACT FRAC INT
- retract : % -> V                     
- retractIfCan : % -> Union(R,"failed")
- retractIfCan : % -> Union(Integer,"failed")
-   if R has RETRACT INT
- retractIfCan : % -> Union(Fraction Integer,"failed")
-   if R has RETRACT FRAC INT
- retractIfCan : % -> Union(V,"failed")
- sample : () -> %                     
- solveLinearPolynomialEquation : 
-   (List SparseUnivariatePolynomial %,
-    SparseUnivariatePolynomial %) -> 
-     Union(List SparseUnivariatePolynomial %,"failed")
-       if R has PFECAT
- squareFree : % -> Factored % if R has GCDDOM
- squareFreePart : % -> % if R has GCDDOM
- squareFreePolynomial : 
-   SparseUnivariatePolynomial % -> 
-     Factored SparseUnivariatePolynomial %
-       if R has PFECAT
- subtractIfCan : (%,%) -> Union(%,"failed")
- totalDegree : (%,List V) -> NonNegativeInteger
- totalDegree : % -> NonNegativeInteger
- unit? : % -> Boolean if R has INTDOM
- unitCanonical : % -> % if R has INTDOM
+    SparseUnivariatePolynomial %) ->
+       SparseUnivariatePolynomial %
+ inv : % -> %                         
+ lcm : (%,%) -> %                     
+ lcm : List % -> %
+ multiEuclidean : (List %,%) -> Union(List %,"failed")
+ prime? : % -> Boolean                
+ principalIdeal : List % -> Record(coef: List %,generator: %)
+ sizeLess? : (%,%) -> Boolean
+ squareFree : % -> Factored %
+ squareFreePart : % -> %              
+ unit? : % -> Boolean
+ unitCanonical : % -> %               
  unitNormal : % -> Record(unit: %,canonical: %,associate: %)
-   if R has INTDOM
- univariate : % -> SparseUnivariatePolynomial R
- univariate : (%,V) -> SparseUnivariatePolynomial %
- variables : % -> List V
- zero? : % -> Boolean                 
- ?+? : (%,%) -> %                     
- ?=? : (%,%) -> Boolean
- ?~=? : (%,%) -> Boolean
- ?*? : (%,R) -> %                     
- ?*? : (R,%) -> %
- ?*? : (Fraction Integer,%) -> % if R has ALGEBRA FRAC INT
- ?*? : (%,Fraction Integer) -> % if R has ALGEBRA FRAC INT
- ?*? : (%,%) -> %                     
- ?*? : (Integer,%) -> %
- ?*? : (PositiveInteger,%) -> %       
- ?*? : (NonNegativeInteger,%) -> %
- ?/? : (%,R) -> % if R has FIELD
- ?-? : (%,%) -> %
- -? : % -> %                          
- ?**? : (%,PositiveInteger) -> %
- ?**? : (%,NonNegativeInteger) -> %
- ?^? : (%,NonNegativeInteger) -> %
- ?^? : (%,PositiveInteger) -> %       
- ?<? : (%,%) -> Boolean if R has ORDSET
- ?<=? : (%,%) -> Boolean if R has ORDSET
- ?>? : (%,%) -> Boolean if R has ORDSET
- ?>=? : (%,%) -> Boolean if R has ORDSET
+ ?/? : (%,%) -> %
+ ?*? : (Fraction Integer,%) -> %
+ ?*? : (Fraction Integer,%) -> %
+ ?*? : (%,Fraction Integer) -> %      
+ ?*? : (%,Fraction Integer) -> %      
+ ?**? : (%,Integer) -> %              
+ ?^? : (%,Integer) -> %
+ ?quo? : (%,%) -> %
+ ?rem? : (%,%) -> %
+\end{verbatim}
+
+These exports come from \refto{FullyRetractableTo}(Fraction(Integer)):
+\begin{verbatim}
+ retract : % -> Fraction Integer      
+ retract : % -> Fraction Integer 
+   if Fraction Integer has RETRACT FRAC INT
+ retract : % -> Integer if Fraction Integer has RETRACT INT
+ retractIfCan : % -> Union(Fraction Integer,"failed")
+ retractIfCan : % -> Union(Fraction Integer,"failed") 
+   if Fraction Integer has RETRACT FRAC INT
+ retractIfCan : % -> Union(Integer,"failed") 
+   if Fraction Integer has RETRACT INT
+\end{verbatim}
+
+These exports come from \refto{Algebra}(Integer):
+\begin{verbatim}
+ ?*? : (%,Integer) -> %               
 \end{verbatim}
 
-\begin{chunk}{category RPOLCAT RecursivePolynomialCategory}
-)abbrev category RPOLCAT RecursivePolynomialCategory
-++ Author: Marc Moreno Maza
-++ Date Created: 04/22/1994
-++ Date Last Updated: 14/12/1998
-++ Description:
+\begin{chunk}{category RCFIELD RealClosedField}
+)abbrev category RCFIELD RealClosedField
+++ Author: Renaud Rioboo
+++ Date Created: may 1993
+++ Date Last Updated: January 2004
+++ Description:
+++ \axiomType{RealClosedField} provides common access
+++ functions for all real closed fields.
+++ provides computations with generic real roots of polynomials 
+
+RealClosedField : Category == PUB where
+
+    E ==> OutputForm
+    SUP ==> SparseUnivariatePolynomial
+    OFIELD ==> Join(OrderedRing,Field)
+    PME ==> SUP($)
+    N ==> NonNegativeInteger
+    PI ==> PositiveInteger
+    RN ==> Fraction(Integer)
+    Z  ==> Integer
+    POLY ==> Polynomial
+    PACK ==> SparseUnivariatePolynomialFunctions2
+
+    PUB == Join(CharacteristicZero,
+                OrderedRing,
+                CommutativeRing,
+                Field,
+                FullyRetractableTo(Fraction(Integer)),
+                Algebra Integer,
+                Algebra(Fraction(Integer)),
+                RadicalCategory) with
+
+        mainForm :   $ -> Union(E,"failed")
+             ++ \axiom{mainForm(x)} is the main algebraic quantity name of 
+             ++ \axiom{x}
+
+        mainDefiningPolynomial :   $ -> Union(PME,"failed")
+             ++ \axiom{mainDefiningPolynomial(x)} is the defining 
+             ++ polynomial for the main algebraic quantity of \axiom{x}
+
+        mainValue :   $ -> Union(PME,"failed")
+             ++ \axiom{mainValue(x)} is the expression of \axiom{x} in terms
+             ++ of \axiom{SparseUnivariatePolynomial($)} 
+
+        rootOf:          (PME,PI,E)           -> Union($,"failed")
+             ++ \axiom{rootOf(pol,n,name)} creates the nth root for the order
+             ++ of \axiom{pol} and names it \axiom{name}
+
+        rootOf:          (PME,PI)             -> Union($,"failed")
+             ++ \axiom{rootOf(pol,n)} creates the nth root for the order
+             ++ of \axiom{pol} and gives it unique name
+
+        allRootsOf:       PME                ->  List $
+             ++ \axiom{allRootsOf(pol)} creates all the roots
+             ++ of \axiom{pol} naming each uniquely
+
+        allRootsOf:       (SUP(RN))          ->  List $
+             ++ \axiom{allRootsOf(pol)} creates all the roots
+             ++ of \axiom{pol} naming each uniquely
+
+        allRootsOf:       (SUP(Z))          ->  List $
+             ++ \axiom{allRootsOf(pol)} creates all the roots
+             ++ of \axiom{pol} naming each uniquely
+
+        allRootsOf:       (POLY($))         ->  List $
+             ++ \axiom{allRootsOf(pol)} creates all the roots
+             ++ of \axiom{pol} naming each uniquely
+
+        allRootsOf:       (POLY(RN))        ->  List $
+             ++ \axiom{allRootsOf(pol)} creates all the roots
+             ++ of \axiom{pol} naming each uniquely
+
+        allRootsOf:       (POLY(Z))         ->  List $
+             ++ \axiom{allRootsOf(pol)} creates all the roots
+             ++ of \axiom{pol} naming each uniquely
+
+        sqrt:            ($,N)                ->     $
+             ++ \axiom{sqrt(x,n)} is \axiom{x ** (1/n)}
+
+        sqrt:              $                  ->     $
+             ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)}
+
+        sqrt:             RN                  ->     $
+             ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)}
+
+        sqrt:              Z                  ->     $
+             ++ \axiom{sqrt(x)} is \axiom{x ** (1/2)}
+
+        rename! :        ($,E)                ->     $
+             ++ \axiom{rename!(x,name)} changes the way \axiom{x} is printed
+
+        rename :         ($,E)                ->     $
+             ++ \axiom{rename(x,name)} gives a new number that prints as name
+
+        approximate:       ($,$) -> RN
+              ++ \axiom{approximate(n,p)} gives an approximation of \axiom{n}
+              ++ that has precision \axiom{p}
+
+      add
+
+        sqrt(a:$):$ == sqrt(a,2)
+
+        sqrt(a:RN):$ == sqrt(a::$,2)
+
+        sqrt(a:Z):$ == sqrt(a::$,2)
+
+        characteristic() == 0
+
+        rootOf(pol,n,o) == 
+          r := rootOf(pol,n)
+          r case "failed" => "failed"
+          rename!(r,o)
+
+        rootOf(pol,n) ==
+          liste:List($):= allRootsOf(pol)
+          # liste > n => "failed"
+          liste.n
+
+
+        sqrt(x,n) ==
+          n = 0 => 1
+          n = 1 => x
+          zero?(x) => 0
+          one?(x) => 1 
+          if odd?(n)
+          then
+            r := rootOf(monomial(1,n) - (x :: PME), 1)
+          else
+            r := rootOf(monomial(1,n) - (x :: PME), 2)
+          r case "failed" => error "no roots"
+          n = 2 => rename(r,root(x::E)$E)
+          rename(r,root(x :: E, n :: E)$E)
+
+        (x : $) ** (rn : RN) == sqrt(x**numer(rn),denom(rn)::N)
+
+        nthRoot(x, n) == 
+          zero?(n) => x
+          negative?(n) => inv(sqrt(x,(-n) :: N))
+          sqrt(x,n :: N)
+
+        allRootsOf(p:SUP(RN)) == allRootsOf(map(z +-> z::$ ,p)$PACK(RN,$))
+
+        allRootsOf(p:SUP(Z)) == allRootsOf(map(z +-> z::$ ,p)$PACK(Z,$))
+
+        allRootsOf(p:POLY($)) == allRootsOf(univariate(p))
+
+        allRootsOf(p:POLY(RN)) == allRootsOf(univariate(p))
+
+        allRootsOf(p:POLY(Z)) == allRootsOf(univariate(p))
+
+\end{chunk}
+
+\begin{chunk}{COQ RCFIELD}
+(* category RCFIELD *)
+(*
+
+        sqrt : % -> %
+        sqrt(a:$):$ == sqrt(a,2)
+
+        sqrt : Fraction(Integer) -> %
+        sqrt(a:RN):$ == sqrt(a::$,2)
+
+        sqrt : Integer -> %
+        sqrt(a:Z):$ == sqrt(a::$,2)
+
+        characteristic : () -> NonNegativeInteger
+        characteristic() == 0
+
+        rootOf : (SparseUnivariatePolynomial(%),PositiveInteger,OutputForm) ->
+            Union(%,"failed")
+        rootOf(pol,n,o) == 
+          r := rootOf(pol,n)
+          r case "failed" => "failed"
+          rename!(r,o)
+
+        rootOf : (SparseUnivariatePolynomial(%),PositiveInteger) ->
+            Union(%,"failed")
+        rootOf(pol,n) ==
+          liste:List($):= allRootsOf(pol)
+          # liste > n => "failed"
+          liste.n
+
+        sqrt : Fraction(Integer) -> %
+        sqrt(x,n) ==
+          n = 0 => 1
+          n = 1 => x
+          zero?(x) => 0
+          one?(x) => 1 
+          if odd?(n)
+          then
+            r := rootOf(monomial(1,n) - (x :: PME), 1)
+          else
+            r := rootOf(monomial(1,n) - (x :: PME), 2)
+          r case "failed" => error "no roots"
+          n = 2 => rename(r,root(x::E)$E)
+          rename(r,root(x :: E, n :: E)$E)
+
+        ?**? : (%,Fraction(Integer)) -> %
+        (x : $) ** (rn : RN) == sqrt(x**numer(rn),denom(rn)::N)
+
+        nthRoot : (%,Integer) -> %
+        nthRoot(x, n) == 
+          zero?(n) => x
+          negative?(n) => inv(sqrt(x,(-n) :: N))
+          sqrt(x,n :: N)
+
+        allRootsOf : SparseUnivariatePolynomial(Fraction(Integer)) -> List(%)
+        allRootsOf(p:SUP(RN)) == allRootsOf(map(z +-> z::$ ,p)$PACK(RN,$))
+
+        allRootsOf : SparseUnivariatePolynomial(Integer) -> List(%)
+        allRootsOf(p:SUP(Z)) == allRootsOf(map(z +-> z::$ ,p)$PACK(Z,$))
+
+        allRootsOf : Polynomial(%) -> List(%)
+        allRootsOf(p:POLY($)) == allRootsOf(univariate(p))
+
+        allRootsOf : Polynomial(Fraction(Integer)) -> List(%)
+        allRootsOf(p:POLY(RN)) == allRootsOf(univariate(p))
+
+        allRootsOf : Polynomial(Integer) -> List(%)
+        allRootsOf(p:POLY(Z)) == allRootsOf(univariate(p))
+*)
+
+\end{chunk}
+
+\begin{chunk}{RCFIELD.dotabb}
+"RCFIELD"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=RCFIELD"];
+"RCFIELD" -> "ALGEBRA"
+"RCFIELD" -> "CHARZ"
+"RCFIELD" -> "COMRING"
+"RCFIELD" -> "FIELD"
+"RCFIELD" -> "FRETRCT"
+"RCFIELD" -> "ORDRING"
+"RCFIELD" -> "RADCAT"
+
+\end{chunk}
+\begin{chunk}{RCFIELD.dotfull}
+"RealClosedField()" 
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=RCFIELD"];
+"RealClosedField()" -> "Algebra(Integer)"
+"RealClosedField()" -> "Algebra(Fraction(Integer))"
+"RealClosedField()" -> "CharacteristicZero()"
+"RealClosedField()" -> "CommutativeRing()"
+"RealClosedField()" -> "Field()"
+"RealClosedField()" -> "FullyRetractableTo(Fraction(Integer))"
+"RealClosedField()" -> "OrderedRing()"
+"RealClosedField()" -> "RadicalCategory()"
+
+\end{chunk}
+\begin{chunk}{RCFIELD.dotpic}
+digraph pic {
+ fontsize=10;
+ bgcolor="#ECEA81";
+ node [shape=box, color=white, style=filled];
+
+"RealClosedField()" [color=lightblue];
+"RealClosedField()" -> "ALGEBRA..."
+"RealClosedField()" -> "CHARZ..."
+"RealClosedField()" -> "COMRING..."
+"RealClosedField()" -> "FIELD..."
+"RealClosedField()" -> "FRETRCT..."
+"RealClosedField()" -> "ORDRING..."
+"RealClosedField()" -> "RADCAT..."
+
+"ALGEBRA..." [color=lightblue];
+"CHARZ..." [color=lightblue];
+"COMRING..." [color=lightblue];
+"FIELD..." [color=lightblue];
+"FRETRCT..." [color=lightblue];
+"ORDRING..." [color=lightblue];
+"RADCAT..." [color=lightblue];
+
+}
+
+\end{chunk}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\pagehead{RealNumberSystem}{RNS}
+\pagepic{ps/v102realnumbersystem.ps}{RNS}{0.50}
+
+\begin{chunk}{RealNumberSystem.input}
+)set break resume
+)sys rm -f RealNumberSystem.output
+)spool RealNumberSystem.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show RealNumberSystem
+--R 
+--R RealNumberSystem  is a category constructor
+--R Abbreviation for RealNumberSystem is RNS 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.2.pamphlet to see algebra source code for RNS 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (Fraction(Integer),%) -> %      ?*? : (%,Fraction(Integer)) -> %
+--R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?**? : (%,Fraction(Integer)) -> %     ?**? : (%,Integer) -> %
+--R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
+--R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
+--R -? : % -> %                           ?/? : (%,%) -> %
+--R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
+--R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
+--R ?>=? : (%,%) -> Boolean               1 : () -> %
+--R 0 : () -> %                           ?^? : (%,Integer) -> %
+--R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
+--R abs : % -> %                          associates? : (%,%) -> Boolean
+--R ceiling : % -> %                      coerce : Fraction(Integer) -> %
+--R coerce : Integer -> %                 coerce : Fraction(Integer) -> %
+--R coerce : % -> %                       coerce : Integer -> %
+--R coerce : % -> OutputForm              convert : % -> Pattern(Float)
+--R convert : % -> DoubleFloat            convert : % -> Float
+--R factor : % -> Factored(%)             floor : % -> %
+--R fractionPart : % -> %                 gcd : List(%) -> %
+--R gcd : (%,%) -> %                      hash : % -> SingleInteger
+--R inv : % -> %                          latex : % -> String
+--R lcm : List(%) -> %                    lcm : (%,%) -> %
+--R max : (%,%) -> %                      min : (%,%) -> %
+--R negative? : % -> Boolean              norm : % -> %
+--R nthRoot : (%,Integer) -> %            one? : % -> Boolean
+--R positive? : % -> Boolean              prime? : % -> Boolean
+--R ?quo? : (%,%) -> %                    recip : % -> Union(%,"failed")
+--R ?rem? : (%,%) -> %                    retract : % -> Fraction(Integer)
+--R retract : % -> Integer                round : % -> %
+--R sample : () -> %                      sign : % -> Integer
+--R sizeLess? : (%,%) -> Boolean          sqrt : % -> %
+--R squareFree : % -> Factored(%)         squareFreePart : % -> %
+--R truncate : % -> %                     unit? : % -> Boolean
+--R unitCanonical : % -> %                wholePart : % -> Integer
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R characteristic : () -> NonNegativeInteger
+--R divide : (%,%) -> Record(quotient: %,remainder: %)
+--R euclideanSize : % -> NonNegativeInteger
+--R expressIdealMember : (List(%),%) -> Union(List(%),"failed")
+--R exquo : (%,%) -> Union(%,"failed")
+--R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
+--R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
+--R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
+--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
+--R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
+--R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%)
+--R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
+--R retractIfCan : % -> Union(Fraction(Integer),"failed")
+--R retractIfCan : % -> Union(Integer,"failed")
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+
+\begin{chunk}{RealNumberSystem.help}
+====================================================================
+RealNumberSystem examples
+====================================================================
+
+The real number system category is intended as a model for the real
+numbers.  The real numbers form an ordered normed field.  Note that
+we have purposely not included DifferentialRing or the elementary 
+functions (see TranscendentalFunctionCategory) in the definition.
+
+See Also:
+o )show RealNumberSystem
+o )show TranscendentalFunctionCategory
+
+\end{chunk}
+{\bf See:}
+
+\pageto{FloatingPointSystem}{FPS}
+\pagefrom{CharacteristicZero}{CHARZ}
+\pagefrom{ConvertibleTo}{KONVERT}
+\pagefrom{Field}{FIELD}
+\pagefrom{OrderedRing}{ORDRING}
+\pagefrom{PatternMatchable}{PATMAB}
+\pagefrom{RadicalCategory}{RADCAT}
+\pagefrom{RealConstant}{REAL}
+\pagefrom{RetractableTo}{RETRACT}
+
+{\bf Exports:}\\
+
+\begin{tabular}{llll}
+\cross{RNS}{0} &
+\cross{RNS}{1} &
+\cross{RNS}{abs} &
+\cross{RNS}{associates?} \\
+\cross{RNS}{ceiling} &
+\cross{RNS}{characteristic} &
+\cross{RNS}{coerce} &
+\cross{RNS}{convert} \\
+\cross{RNS}{divide} &
+\cross{RNS}{euclideanSize} &
+\cross{RNS}{expressIdealMember} &
+\cross{RNS}{exquo} \\
+\cross{RNS}{extendedEuclidean} &
+\cross{RNS}{factor} &
+\cross{RNS}{floor} &
+\cross{RNS}{fractionPart} \\
+\cross{RNS}{gcd} &
+\cross{RNS}{gcdPolynomial} &
+\cross{RNS}{hash} &
+\cross{RNS}{inv} \\
+\cross{RNS}{latex} &
+\cross{RNS}{lcm} &
+\cross{RNS}{max} &
+\cross{RNS}{min} \\
+\cross{RNS}{multiEuclidean} &
+\cross{RNS}{negative?} &
+\cross{RNS}{norm} &
+\cross{RNS}{nthRoot} \\
+\cross{RNS}{one?} &
+\cross{RNS}{patternMatch} &
+\cross{RNS}{positive?} &
+\cross{RNS}{prime?} \\
+\cross{RNS}{principalIdeal} &
+\cross{RNS}{recip} &
+\cross{RNS}{retract} &
+\cross{RNS}{retractIfCan} \\
+\cross{RNS}{round} &
+\cross{RNS}{sample} &
+\cross{RNS}{sign} &
+\cross{RNS}{sizeLess?} \\
+\cross{RNS}{sqrt} &
+\cross{RNS}{squareFree} &
+\cross{RNS}{squareFreePart} &
+\cross{RNS}{subtractIfCan} \\
+\cross{RNS}{truncate} &
+\cross{RNS}{unit?} &
+\cross{RNS}{unitCanonical} &
+\cross{RNS}{unitNormal} \\
+\cross{RNS}{wholePart} &
+\cross{RNS}{zero?} &
+\cross{RNS}{?*?} &
+\cross{RNS}{?**?} \\
+\cross{RNS}{?+?} &
+\cross{RNS}{?-?} &
+\cross{RNS}{-?} &
+\cross{RNS}{?/?} \\
+\cross{RNS}{?$<$?} &
+\cross{RNS}{?$<=$?} &
+\cross{RNS}{?=?} &
+\cross{RNS}{?$>$?} \\
+\cross{RNS}{?$>=$?} &
+\cross{RNS}{?\^{}?} &
+\cross{RNS}{?quo?} &
+\cross{RNS}{?rem?} \\
+\cross{RNS}{?\~{}=?} &&
+\end{tabular}
+
+These are directly exported but not implemented:
+\begin{verbatim}
+ abs : % -> %
+ wholePart : % -> Integer             
+\end{verbatim}
+
+These are implemented by this category:
+\begin{verbatim}
+ characteristic : () -> NonNegativeInteger
+ ceiling : % -> %
+ coerce : Fraction Integer -> %       
+ convert : % -> Pattern Float         
+ floor : % -> %                       
+ fractionPart : % -> %
+ norm : % -> %                        
+ patternMatch :
+   (%,Pattern Float,PatternMatchResult(Float,%)) -> 
+     PatternMatchResult(Float,%)
+ round : % -> %                       
+ truncate : % -> %
+\end{verbatim}
+
+These exports come from \refto{Field}():
+\begin{verbatim}
+ 0 : () -> %                          
+ 1 : () -> %
+ associates? : (%,%) -> Boolean       
+ coerce : % -> %
+ coerce : Integer -> %
+ coerce : Integer -> %                
+ coerce : Fraction Integer -> %       
+ coerce : % -> OutputForm
+ divide : (%,%) -> Record(quotient: %,remainder: %)
+ euclideanSize : % -> NonNegativeInteger
+ expressIdealMember : (List %,%) -> Union(List %,"failed")
+ extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed")
+ extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %)
+ exquo : (%,%) -> Union(%,"failed")
+ factor : % -> Factored %
+ gcd : List % -> %                    
+ gcd : (%,%) -> %
+ gcdPolynomial : 
+   (SparseUnivariatePolynomial %,
+    SparseUnivariatePolynomial %) ->
+       SparseUnivariatePolynomial %
+ hash : % -> SingleInteger            
+ inv : % -> %
+ latex : % -> String                  
+ lcm : List % -> %
+ lcm : (%,%) -> %                     
+ multiEuclidean : (List %,%) -> Union(List %,"failed")
+ one? : % -> Boolean                  
+ prime? : % -> Boolean                
+ principalIdeal : List % -> Record(coef: List %,generator: %)
+ recip : % -> Union(%,"failed")       
+ sample : () -> %
+ sizeLess? : (%,%) -> Boolean
+ squareFree : % -> Factored %
+ squareFreePart : % -> %              
+ subtractIfCan : (%,%) -> Union(%,"failed")
+ unit? : % -> Boolean                 
+ unitCanonical : % -> %
+ unitNormal : % -> Record(unit: %,canonical: %,associate: %)
+ zero? : % -> Boolean
+ ?+? : (%,%) -> %                     
+ ?=? : (%,%) -> Boolean               
+ ?~=? : (%,%) -> Boolean              
+ ?*? : (Fraction Integer,%) -> %      
+ ?*? : (%,Fraction Integer) -> %
+ ?**? : (%,Fraction Integer) -> %
+ ?^? : (%,Integer) -> %
+ ?*? : (%,%) -> %                     
+ ?*? : (Integer,%) -> %
+ ?*? : (PositiveInteger,%) -> %       
+ ?*? : (NonNegativeInteger,%) -> %
+ ?-? : (%,%) -> %
+ -? : % -> %                          
+ ?**? : (%,PositiveInteger) -> %
+ ?**? : (%,NonNegativeInteger) -> %
+ ?^? : (%,NonNegativeInteger) -> %
+ ?^? : (%,PositiveInteger) -> %       
+ ?/? : (%,%) -> %
+ ?quo? : (%,%) -> %
+ ?rem? : (%,%) -> %
+\end{verbatim}
+
+These exports come from \refto{OrderedRing}():
+\begin{verbatim}
+ negative? : % -> Boolean
+ positive? : % -> Boolean
+ sign : % -> Integer                  
+ max : (%,%) -> %
+ min : (%,%) -> %                     
+ ?<? : (%,%) -> Boolean               
+ ?<=? : (%,%) -> Boolean
+ ?>? : (%,%) -> Boolean
+ ?>=? : (%,%) -> Boolean              
+\end{verbatim}
+
+These exports come from \refto{RealConstant}():
+\begin{verbatim}
+ convert : % -> DoubleFloat
+ convert : % -> Float                 
+\end{verbatim}
+
+These exports come from \refto{RetractableTo}(Integer):
+\begin{verbatim}
+ retract : % -> Integer
+ retractIfCan : % -> Union(Integer,"failed")
+\end{verbatim}
+
+These exports come from \refto{RetractableTo}(Fraction(Integer)):
+\begin{verbatim}
+ retract : % -> Fraction Integer      
+ retractIfCan : % -> Union(Fraction Integer,"failed")
+\end{verbatim}
+
+These exports come from \refto{RadicalCategory}():
+\begin{verbatim}
+ nthRoot : (%,Integer) -> %
+ sqrt : % -> %                        
+\end{verbatim}
+
+These exports come from \refto{ConvertibleTo}(Pattern(Float)):
+\begin{verbatim}
+\end{verbatim}
+
+These exports come from \refto{PatternMatchable}(Float):
+\begin{verbatim}
+\end{verbatim}
+
+These exports come from \refto{CharacteristicZero}():
+\begin{verbatim}
+\end{verbatim}
+
+\begin{chunk}{category RNS RealNumberSystem}
+)abbrev category RNS RealNumberSystem
+++ Author: Michael Monagan and Stephen M. Watt
+++ Date Created: January 1988
+++ Description:  
+++ The real number system category is intended as a model for the real
+++ numbers.  The real numbers form an ordered normed field.  Note that
+++ we have purposely not included \spadtype{DifferentialRing} or 
+++ the elementary functions (see \spadtype{TranscendentalFunctionCategory})
+++ in the definition.
+
+RealNumberSystem(): Category ==
+  Join(Field, OrderedRing, RealConstant, RetractableTo Integer,
+       RetractableTo Fraction Integer, RadicalCategory,
+        ConvertibleTo Pattern Float, PatternMatchable Float,
+          CharacteristicZero) with
+    norm : % -> %
+      ++ norm x returns the same as absolute value.
+    ceiling : % -> %
+      ++ ceiling x returns the small integer \spad{>= x}.
+    floor: % -> %
+      ++ floor x returns the largest integer \spad{<= x}.
+    wholePart  : % -> Integer
+      ++ wholePart x returns the integer part of x.
+    fractionPart : % -> %
+      ++ fractionPart x returns the fractional part of x.
+    truncate: % -> %
+      ++ truncate x returns the integer between x and 0 closest to x.
+    round: % -> %
+      ++ round x computes the integer closest to x.
+    abs  : % -> %
+      ++ abs x returns the absolute value of x.
+ add
+   characteristic() == 0
+
+   fractionPart x == x - truncate x
+
+   truncate x == (negative? x => -floor(-x); floor x)
+
+   round x == (negative? x => truncate(x-1/2::%); truncate(x+1/2::%))
+
+   norm x == abs x
+
+   coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::%
+
+   convert(x:%):Pattern(Float)  == convert(x)@Float :: Pattern(Float)
+
+   floor x ==
+      x1 := (wholePart x) :: %
+      x = x1 => x
+      x < 0 => (x1 - 1)
+      x1
+
+   ceiling x ==
+      x1 := (wholePart x)::%
+      x = x1 => x
+      x >= 0 => (x1 + 1)
+      x1
+
+   patternMatch(x, p, l) ==
+     generic? p => addMatch(p, x, l)
+     constant? p =>
+       (r := retractIfCan(p)@Union(Float, "failed")) case Float =>
+         convert(x)@Float = r::Float => l
+         failed()
+       failed()
+     failed()
+
+\end{chunk}
+
+\begin{chunk}{COQ RNS}
+(* category RNS *)
+(*
+
+   characteristic : () -> NonNegativeInteger
+   characteristic() == 0
+
+   fractionPart : % -> %
+   fractionPart x == x - truncate x
+
+   truncate : % -> %
+   truncate x == (negative? x => -floor(-x); floor x)
+
+   round : % -> %
+   round x == (negative? x => truncate(x-1/2::%); truncate(x+1/2::%))
+
+   norm : % -> %
+   norm x == abs x
+
+   coerce : Fraction(Integer) -> %
+   coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::%
+
+   convert : % -> Pattern(Float)
+   convert(x:%):Pattern(Float)  == convert(x)@Float :: Pattern(Float)
+
+   floor : % -> %
+   floor x ==
+      x1 := (wholePart x) :: %
+      x = x1 => x
+      x < 0 => (x1 - 1)
+      x1
+
+   ceiling : % -> %
+   ceiling x ==
+      x1 := (wholePart x)::%
+      x = x1 => x
+      x >= 0 => (x1 + 1)
+      x1
+
+   patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) ->
+      PatternMatchResult(Float,%)
+   patternMatch(x, p, l) ==
+     generic? p => addMatch(p, x, l)
+     constant? p =>
+       (r := retractIfCan(p)@Union(Float, "failed")) case Float =>
+         convert(x)@Float = r::Float => l
+         failed()
+       failed()
+     failed()
+*)
+
+\end{chunk}
+
+\begin{chunk}{RNS.dotabb}
+"RNS"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=RNS"];
+"RNS" -> "FIELD"
+"RNS" -> "ORDRING"
+"RNS" -> "REAL"
+"RNS" -> "RETRACT"
+"RNS" -> "RADCAT"
+"RNS" -> "KONVERT"
+"RNS" -> "PATMAB"
+"RNS" -> "CHARZ"
+
+\end{chunk}
+\begin{chunk}{RNS.dotfull}
+"RealNumberSystem()"
+ [color=lightblue,href="bookvol10.2.pdf#nameddest=RNS"];
+"RealNumberSystem()" -> "Field()"
+"RealNumberSystem()" -> "OrderedRing()"
+"RealNumberSystem()" -> "RealConstant()"
+"RealNumberSystem()" -> "RetractableTo(Integer)"
+"RealNumberSystem()" -> "RetractableTo(Fraction(Integer))"
+"RealNumberSystem()" -> "RadicalCategory()"
+"RealNumberSystem()" -> "ConvertibleTo(Pattern(Float))"
+"RealNumberSystem()" -> "PatternMatchable(Float)"
+"RealNumberSystem()" -> "CharacteristicZero()"
+
+\end{chunk}
+\begin{chunk}{RNS.dotpic}
+digraph pic {
+ fontsize=10;
+ bgcolor="#ECEA81";
+ node [shape=box, color=white, style=filled];
+
+"RealNumberSystem()" [color=lightblue];
+"RealNumberSystem()" -> "FIELD..."
+"RealNumberSystem()" -> "ORDRING..."
+"RealNumberSystem()" -> "REAL..."
+"RealNumberSystem()" -> "RETRACT..."
+"RealNumberSystem()" -> "RADCAT..."
+"RealNumberSystem()" -> "KONVERT..."
+"RealNumberSystem()" -> "PATMAB..."
+"RealNumberSystem()" -> "CHARZ..."
+
+"FIELD..." [color=lightblue];
+"ORDRING..." [color=lightblue];
+"REAL..." [color=lightblue];
+"RETRACT..." [color=lightblue];
+"RADCAT..." [color=lightblue];
+"KONVERT..." [color=lightblue];
+"PATMAB..." [color=lightblue];
+"CHARZ..." [color=lightblue];
+}
+
+\end{chunk}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\pagehead{RecursivePolynomialCategory}{RPOLCAT}
+\pagepic{ps/v102recursivepolynomialcategory.ps}{RPOLCAT}{0.30}
+
+\begin{chunk}{RecursivePolynomialCategory.input}
+)set break resume
+)sys rm -f RecursivePolynomialCategory.output
+)spool RecursivePolynomialCategory.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show RecursivePolynomialCategory
+--R 
+--R RecursivePolynomialCategory(R: Ring,E: OrderedAbelianMonoidSup,V: OrderedSet)  is a category constructor
+--R Abbreviation for RecursivePolynomialCategory is RPOLCAT 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.2.pamphlet to see algebra source code for RPOLCAT 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
+--R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
+--R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
+--R -? : % -> %                           ?/? : (%,R) -> % if R has FIELD
+--R ?=? : (%,%) -> Boolean                D : (%,V,NonNegativeInteger) -> %
+--R D : (%,List(V)) -> %                  D : (%,V) -> %
+--R 1 : () -> %                           0 : () -> %
+--R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
+--R coefficient : (%,E) -> R              coefficients : % -> List(R)
+--R coerce : % -> % if R has INTDOM       coerce : V -> %
+--R coerce : R -> %                       coerce : Integer -> %
+--R coerce : % -> OutputForm              content : % -> R if R has GCDDOM
+--R deepestInitial : % -> %               deepestTail : % -> %
+--R degree : % -> E                       differentiate : (%,List(V)) -> %
+--R differentiate : (%,V) -> %            eval : (%,List(V),List(%)) -> %
+--R eval : (%,V,%) -> %                   eval : (%,List(V),List(R)) -> %
+--R eval : (%,V,R) -> %                   eval : (%,List(%),List(%)) -> %
+--R eval : (%,%,%) -> %                   eval : (%,Equation(%)) -> %
+--R eval : (%,List(Equation(%))) -> %     gcd : (%,%) -> % if R has GCDDOM
+--R gcd : List(%) -> % if R has GCDDOM    gcd : (R,%) -> R if R has GCDDOM
+--R ground : % -> R                       ground? : % -> Boolean
+--R hash : % -> SingleInteger             head : % -> %
+--R headReduce : (%,%) -> %               headReduced? : (%,%) -> Boolean
+--R infRittWu? : (%,%) -> Boolean         init : % -> %
+--R initiallyReduce : (%,%) -> %          iteratedInitials : % -> List(%)
+--R latex : % -> String                   lazyPquo : (%,%,V) -> %
+--R lazyPquo : (%,%) -> %                 lazyPrem : (%,%,V) -> %
+--R lazyPrem : (%,%) -> %                 lcm : (%,%) -> % if R has GCDDOM
+--R lcm : List(%) -> % if R has GCDDOM    leadingCoefficient : (%,V) -> %
+--R leadingCoefficient : % -> R           leadingMonomial : % -> %
+--R leastMonomial : % -> %                mainCoefficients : % -> List(%)
+--R mainMonomial : % -> %                 mainMonomials : % -> List(%)
+--R map : ((R -> R),%) -> %               mapExponents : ((E -> E),%) -> %
+--R max : (%,%) -> % if R has ORDSET      mdeg : % -> NonNegativeInteger
+--R min : (%,%) -> % if R has ORDSET      minimumDegree : % -> E
+--R monic? : % -> Boolean                 monicModulo : (%,%) -> %
+--R monomial : (R,E) -> %                 monomial? : % -> Boolean
+--R monomials : % -> List(%)              mvar : % -> V
+--R normalized? : (%,%) -> Boolean        one? : % -> Boolean
+--R pomopo! : (%,R,E,%) -> %              pquo : (%,%,V) -> %
+--R pquo : (%,%) -> %                     prem : (%,%,V) -> %
+--R prem : (%,%) -> %                     primitiveMonomials : % -> List(%)
+--R quasiMonic? : % -> Boolean            recip : % -> Union(%,"failed")
+--R reduced? : (%,List(%)) -> Boolean     reduced? : (%,%) -> Boolean
+--R reductum : (%,V) -> %                 reductum : % -> %
+--R retract : % -> V                      retract : % -> R
+--R sample : () -> %                      supRittWu? : (%,%) -> Boolean
+--R tail : % -> %                         variables : % -> List(V)
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R ?*? : (Fraction(Integer),%) -> % if R has ALGEBRA(FRAC(INT))
+--R ?*? : (%,Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT))
+--R ?<? : (%,%) -> Boolean if R has ORDSET
+--R ?<=? : (%,%) -> Boolean if R has ORDSET
+--R ?>? : (%,%) -> Boolean if R has ORDSET
+--R ?>=? : (%,%) -> Boolean if R has ORDSET
+--R D : (%,List(V),List(NonNegativeInteger)) -> %
+--R LazardQuotient : (%,%,NonNegativeInteger) -> % if R has INTDOM
+--R LazardQuotient2 : (%,%,%,NonNegativeInteger) -> % if R has INTDOM
+--R RittWuCompare : (%,%) -> Union(Boolean,"failed")
+--R associates? : (%,%) -> Boolean if R has INTDOM
+--R binomThmExpt : (%,%,NonNegativeInteger) -> % if R has COMRING
+--R characteristic : () -> NonNegativeInteger
+--R charthRoot : % -> Union(%,"failed") if and(has($,CharacteristicNonZero),has(R,PolynomialFactorizationExplicit)) or R has CHARNZ
+--R coefficient : (%,List(V),List(NonNegativeInteger)) -> %
+--R coefficient : (%,V,NonNegativeInteger) -> %
+--R coerce : Fraction(Integer) -> % if R has RETRACT(FRAC(INT)) or R has ALGEBRA(FRAC(INT))
+--R coerce : % -> Polynomial(R) if V has KONVERT(SYMBOL)
+--R conditionP : Matrix(%) -> Union(Vector(%),"failed") if and(has($,CharacteristicNonZero),has(R,PolynomialFactorizationExplicit))
+--R content : (%,V) -> % if R has GCDDOM
+--R convert : % -> Polynomial(R) if V has KONVERT(SYMBOL)
+--R convert : % -> String if R has RETRACT(INT) and V has KONVERT(SYMBOL)
+--R convert : Polynomial(R) -> % if V has KONVERT(SYMBOL)
+--R convert : Polynomial(Integer) -> % if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
+--R convert : Polynomial(Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
+--R convert : % -> InputForm if V has KONVERT(INFORM) and R has KONVERT(INFORM)
+--R convert : % -> Pattern(Integer) if V has KONVERT(PATTERN(INT)) and R has KONVERT(PATTERN(INT))
+--R convert : % -> Pattern(Float) if V has KONVERT(PATTERN(FLOAT)) and R has KONVERT(PATTERN(FLOAT))
+--R degree : (%,List(V)) -> List(NonNegativeInteger)
+--R degree : (%,V) -> NonNegativeInteger
+--R differentiate : (%,List(V),List(NonNegativeInteger)) -> %
+--R differentiate : (%,V,NonNegativeInteger) -> %
+--R discriminant : (%,V) -> % if R has COMRING
+--R exactQuotient : (%,%) -> % if R has INTDOM
+--R exactQuotient : (%,R) -> % if R has INTDOM
+--R exactQuotient! : (%,%) -> % if R has INTDOM
+--R exactQuotient! : (%,R) -> % if R has INTDOM
+--R exquo : (%,%) -> Union(%,"failed") if R has INTDOM
+--R exquo : (%,R) -> Union(%,"failed") if R has INTDOM
+--R extendedSubResultantGcd : (%,%) -> Record(gcd: %,coef1: %,coef2: %) if R has INTDOM
+--R factor : % -> Factored(%) if R has PFECAT
+--R factorPolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT
+--R factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT
+--R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) if R has GCDDOM
+--R halfExtendedSubResultantGcd1 : (%,%) -> Record(gcd: %,coef1: %) if R has INTDOM
+--R halfExtendedSubResultantGcd2 : (%,%) -> Record(gcd: %,coef2: %) if R has INTDOM
+--R headReduced? : (%,List(%)) -> Boolean
+--R initiallyReduced? : (%,List(%)) -> Boolean
+--R initiallyReduced? : (%,%) -> Boolean
+--R isExpt : % -> Union(Record(var: V,exponent: NonNegativeInteger),"failed")
+--R isPlus : % -> Union(List(%),"failed")
+--R isTimes : % -> Union(List(%),"failed")
+--R lastSubResultant : (%,%) -> % if R has INTDOM
+--R lazyPremWithDefault : (%,%,V) -> Record(coef: %,gap: NonNegativeInteger,remainder: %)
+--R lazyPremWithDefault : (%,%) -> Record(coef: %,gap: NonNegativeInteger,remainder: %)
+--R lazyPseudoDivide : (%,%,V) -> Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %)
+--R lazyPseudoDivide : (%,%) -> Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %)
+--R lazyResidueClass : (%,%) -> Record(polnum: %,polden: %,power: NonNegativeInteger)
+--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) if R has GCDDOM
+--R mainContent : % -> % if R has GCDDOM
+--R mainPrimitivePart : % -> % if R has GCDDOM
+--R mainSquareFreePart : % -> % if R has GCDDOM
+--R mainVariable : % -> Union(V,"failed")
+--R minimumDegree : (%,List(V)) -> List(NonNegativeInteger)
+--R minimumDegree : (%,V) -> NonNegativeInteger
+--R monicDivide : (%,%,V) -> Record(quotient: %,remainder: %)
+--R monomial : (%,List(V),List(NonNegativeInteger)) -> %
+--R monomial : (%,V,NonNegativeInteger) -> %
+--R multivariate : (SparseUnivariatePolynomial(%),V) -> %
+--R multivariate : (SparseUnivariatePolynomial(R),V) -> %
+--R nextsubResultant2 : (%,%,%,%) -> % if R has INTDOM
+--R normalized? : (%,List(%)) -> Boolean
+--R numberOfMonomials : % -> NonNegativeInteger
+--R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if V has PATMAB(INT) and R has PATMAB(INT)
+--R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if V has PATMAB(FLOAT) and R has PATMAB(FLOAT)
+--R primPartElseUnitCanonical : % -> % if R has INTDOM
+--R primPartElseUnitCanonical! : % -> % if R has INTDOM
+--R prime? : % -> Boolean if R has PFECAT
+--R primitivePart : (%,V) -> % if R has GCDDOM
+--R primitivePart : % -> % if R has GCDDOM
+--R primitivePart! : % -> % if R has GCDDOM
+--R pseudoDivide : (%,%) -> Record(quotient: %,remainder: %)
+--R reducedSystem : Matrix(%) -> Matrix(R)
+--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(R),vec: Vector(R))
+--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if R has LINEXP(INT)
+--R reducedSystem : Matrix(%) -> Matrix(Integer) if R has LINEXP(INT)
+--R resultant : (%,%) -> % if R has INTDOM
+--R resultant : (%,%,V) -> % if R has COMRING
+--R retract : Polynomial(R) -> % if not(has(R,Algebra(Fraction(Integer)))) and not(has(R,Algebra(Integer))) and V has KONVERT(SYMBOL) or not(has(R,IntegerNumberSystem)) and not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or not(has(R,QuotientFieldCategory(Integer))) and R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
+--R retract : Polynomial(Integer) -> % if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
+--R retract : Polynomial(Fraction(Integer)) -> % if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
+--R retract : % -> Integer if R has RETRACT(INT)
+--R retract : % -> Fraction(Integer) if R has RETRACT(FRAC(INT))
+--R retractIfCan : Polynomial(R) -> Union(%,"failed") if not(has(R,Algebra(Fraction(Integer)))) and not(has(R,Algebra(Integer))) and V has KONVERT(SYMBOL) or not(has(R,IntegerNumberSystem)) and not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or not(has(R,QuotientFieldCategory(Integer))) and R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
+--R retractIfCan : Polynomial(Integer) -> Union(%,"failed") if not(has(R,Algebra(Fraction(Integer)))) and R has ALGEBRA(INT) and V has KONVERT(SYMBOL) or R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
+--R retractIfCan : Polynomial(Fraction(Integer)) -> Union(%,"failed") if R has ALGEBRA(FRAC(INT)) and V has KONVERT(SYMBOL)
+--R retractIfCan : % -> Union(V,"failed")
+--R retractIfCan : % -> Union(Integer,"failed") if R has RETRACT(INT)
+--R retractIfCan : % -> Union(Fraction(Integer),"failed") if R has RETRACT(FRAC(INT))
+--R retractIfCan : % -> Union(R,"failed")
+--R solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> Union(List(SparseUnivariatePolynomial(%)),"failed") if R has PFECAT
+--R squareFree : % -> Factored(%) if R has GCDDOM
+--R squareFreePart : % -> % if R has GCDDOM
+--R squareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if R has PFECAT
+--R subResultantChain : (%,%) -> List(%) if R has INTDOM
+--R subResultantGcd : (%,%) -> % if R has INTDOM
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R totalDegree : (%,List(V)) -> NonNegativeInteger
+--R totalDegree : % -> NonNegativeInteger
+--R unit? : % -> Boolean if R has INTDOM
+--R unitCanonical : % -> % if R has INTDOM
+--R unitNormal : % -> Record(unit: %,canonical: %,associate: %) if R has INTDOM
+--R univariate : % -> SparseUnivariatePolynomial(R)
+--R univariate : (%,V) -> SparseUnivariatePolynomial(%)
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+
+\begin{chunk}{RecursivePolynomialCategory.help}
+====================================================================
+RecursivePolynomialCategory examples
+====================================================================
+
+A category for general multi-variate polynomials with coefficients 
+in a ring, variables in an ordered set, and exponents from an 
+ordered abelian monoid, with a sup operation.
+
+When not constant, such a polynomial is viewed as a univariate polynomial 
+in its main variable w. r. t. to the total ordering on the elements in 
+the ordered set, so that some operations usually defined for univariate 
+polynomials make sense here.
+
+See Also:
+o )show RecursivePolynomialCategory
+
+\end{chunk}
+{\bf See:}
+
+\pagefrom{PolynomialCategory}{POLYCAT}
+
+{\bf Exports:}\\
+
+\begin{tabular}{lll}
+\cross{RPOLCAT}{0} &
+\cross{RPOLCAT}{1} &
+\cross{RPOLCAT}{associates?} \\
+\cross{RPOLCAT}{binomThmExpt} &
+\cross{RPOLCAT}{characteristic} &
+\cross{RPOLCAT}{charthRoot} \\
+\cross{RPOLCAT}{coefficient} &
+\cross{RPOLCAT}{coefficients} &
+\cross{RPOLCAT}{coerce} \\
+\cross{RPOLCAT}{conditionP} &
+\cross{RPOLCAT}{convert} &
+\cross{RPOLCAT}{D} \\
+\cross{RPOLCAT}{deepestInitial} &
+\cross{RPOLCAT}{deepestTail} &
+\cross{RPOLCAT}{degree} \\
+\cross{RPOLCAT}{differentiate} &
+\cross{RPOLCAT}{discriminant} &
+\cross{RPOLCAT}{eval} \\
+\cross{RPOLCAT}{exactQuotient} &
+\cross{RPOLCAT}{exactQuotient!} &
+\cross{RPOLCAT}{exquo} \\
+\cross{RPOLCAT}{extendedSubResultantGcd} &
+\cross{RPOLCAT}{factor} &
+\cross{RPOLCAT}{factorPolynomial} \\
+\cross{RPOLCAT}{factorSquareFreePolynomial} &
+\cross{RPOLCAT}{gcd} &
+\cross{RPOLCAT}{gcdPolynomial} \\
+\cross{RPOLCAT}{ground} &
+\cross{RPOLCAT}{ground?} &
+\cross{RPOLCAT}{halfExtendedSubResultantGcd1} \\
+\cross{RPOLCAT}{halfExtendedSubResultantGcd2} &
+\cross{RPOLCAT}{hash} &
+\cross{RPOLCAT}{head} \\
+\cross{RPOLCAT}{headReduce} &
+\cross{RPOLCAT}{headReduced?} &
+\cross{RPOLCAT}{infRittWu?} \\
+\cross{RPOLCAT}{init} &
+\cross{RPOLCAT}{initiallyReduce} &
+\cross{RPOLCAT}{initiallyReduced?} \\
+\cross{RPOLCAT}{isExpt} &
+\cross{RPOLCAT}{isPlus} &
+\cross{RPOLCAT}{isTimes} \\
+\cross{RPOLCAT}{iteratedInitials} &
+\cross{RPOLCAT}{lastSubResultant} &
+\cross{RPOLCAT}{latex} \\
+\cross{RPOLCAT}{LazardQuotient} &
+\cross{RPOLCAT}{LazardQuotient2} &
+\cross{RPOLCAT}{lazyPquo} \\
+\cross{RPOLCAT}{lazyPrem} &
+\cross{RPOLCAT}{lazyPremWithDefault} &
+\cross{RPOLCAT}{lazyPseudoDivide} \\
+\cross{RPOLCAT}{lazyResidueClass} &
+\cross{RPOLCAT}{lcm} &
+\cross{RPOLCAT}{leadingCoefficient} \\
+\cross{RPOLCAT}{leadingMonomial} &
+\cross{RPOLCAT}{leastMonomial} &
+\cross{RPOLCAT}{mainCoefficients} \\
+\cross{RPOLCAT}{mainContent} &
+\cross{RPOLCAT}{mainMonomial} &
+\cross{RPOLCAT}{mainPrimitivePart} \\
+\cross{RPOLCAT}{mainSquareFreePart} &
+\cross{RPOLCAT}{mainVariable} &
+\cross{RPOLCAT}{map} \\
+\cross{RPOLCAT}{mapExponents} &
+\cross{RPOLCAT}{max} &
+\cross{RPOLCAT}{mdeg} \\
+\cross{RPOLCAT}{min} &
+\cross{RPOLCAT}{minimumDegree} &
+\cross{RPOLCAT}{monic?} \\
+\cross{RPOLCAT}{monicDivide} &
+\cross{RPOLCAT}{monicModulo} &
+\cross{RPOLCAT}{monomial} \\
+\cross{RPOLCAT}{monomial?} &
+\cross{RPOLCAT}{monomials} &
+\cross{RPOLCAT}{multivariate} \\
+\cross{RPOLCAT}{mvar} &
+\cross{RPOLCAT}{nextsubResultant2} &
+\cross{RPOLCAT}{normalized?} \\
+\cross{RPOLCAT}{numberOfMonomials} &
+\cross{RPOLCAT}{one?} &
+\cross{RPOLCAT}{patternMatch} \\
+\cross{RPOLCAT}{pomopo!} &
+\cross{RPOLCAT}{pquo} &
+\cross{RPOLCAT}{prem} \\
+\cross{RPOLCAT}{primPartElseUnitCanonical} &
+\cross{RPOLCAT}{primPartElseUnitCanonical!} &
+\cross{RPOLCAT}{prime?} \\
+\cross{RPOLCAT}{primitiveMonomials} &
+\cross{RPOLCAT}{primitivePart} &
+\cross{RPOLCAT}{primitivePart!} \\
+\cross{RPOLCAT}{pseudoDivide} &
+\cross{RPOLCAT}{quasiMonic?} &
+\cross{RPOLCAT}{recip} \\
+\cross{RPOLCAT}{reduced?} &
+\cross{RPOLCAT}{reducedSystem} &
+\cross{RPOLCAT}{reductum} \\
+\cross{RPOLCAT}{resultant} &
+\cross{RPOLCAT}{retract} &
+\cross{RPOLCAT}{retractIfCan} \\
+\cross{RPOLCAT}{RittWuCompare} &
+\cross{RPOLCAT}{sample} &
+\cross{RPOLCAT}{solveLinearPolynomialEquation} \\
+\cross{RPOLCAT}{squareFree} &
+\cross{RPOLCAT}{squareFreePart} &
+\cross{RPOLCAT}{squareFreePolynomial} \\
+\cross{RPOLCAT}{subResultantChain} &
+\cross{RPOLCAT}{subResultantGcd} &
+\cross{RPOLCAT}{subtractIfCan} \\
+\cross{RPOLCAT}{supRittWu?} &
+\cross{RPOLCAT}{tail} &
+\cross{RPOLCAT}{totalDegree} \\
+\cross{RPOLCAT}{unit?} &
+\cross{RPOLCAT}{unitCanonical} &
+\cross{RPOLCAT}{unitNormal} \\
+\cross{RPOLCAT}{univariate} &
+\cross{RPOLCAT}{variables} &
+\cross{RPOLCAT}{zero?} \\
+\cross{RPOLCAT}{?*?} &
+\cross{RPOLCAT}{?**?} &
+\cross{RPOLCAT}{?+?} \\
+\cross{RPOLCAT}{?-?} &
+\cross{RPOLCAT}{-?} &
+\cross{RPOLCAT}{?=?} \\
+\cross{RPOLCAT}{?\^{}?} &
+\cross{RPOLCAT}{?\~{}=?} &
+\cross{RPOLCAT}{?/?} \\
+\cross{RPOLCAT}{?$<$?} &
+\cross{RPOLCAT}{?$<=$?} &
+\cross{RPOLCAT}{?$>$?} \\
+\cross{RPOLCAT}{?$>=$?} &&
+\end{tabular}
+
+{\bf Attributes Exported:}
+\begin{itemize}
+\item if \#1 has CommutativeRing then commutative(``*'') where
+{\bf \cross{RPOLCAT}{commutative(``*'')}}
+is true if it has an operation $"*": (D,D) -> D$
+which is commutative.
+\item if \#1 has IntegralDomain then noZeroDivisors where
+{\bf \cross{RPOLCAT}{noZeroDivisors}}
+is true if $x * y \ne 0$ implies both x and y are non-zero.
+\item if \#1 has canonicalUnitNormal then canonicalUnitNormal
+where {\bf \cross{RPOLCAT}{canonicalUnitNormal}}
+is true if we can choose a canonical representative for each class 
+of associate elements, that is {\tt associates?(a,b)} returns true 
+if and only if {\tt unitCanonical(a) = unitCanonical(b)}.
+\item {\bf \cross{RPOLCAT}{unitsKnown}}
+is true if a monoid (a multiplicative semigroup with a 1) has 
+unitsKnown means that  the operation {\tt recip} can only return 
+``failed'' if its argument is not a unit.
+\item {\bf \cross{RPOLCAT}{leftUnitary}}
+is true if $1 * x = x$ for all x.
+\item {\bf \cross{RPOLCAT}{rightUnitary}}
+is true if $x * 1 = x$ for all x.
+\end{itemize}
+
+These are directly exported but not implemented:
+\begin{verbatim}
+ exactQuotient! : (%,R) -> % if R has INTDOM
+ extendedSubResultantGcd : (%,%) -> Record(gcd: %,coef1: %,coef2: %) 
+   if R has INTDOM
+ halfExtendedSubResultantGcd1 : (%,%) -> Record(gcd: %,coef1: %) 
+   if R has INTDOM
+ halfExtendedSubResultantGcd2 : (%,%) -> Record(gcd: %,coef2: %) 
+   if R has INTDOM
+ lastSubResultant : (%,%) -> % if R has INTDOM
+ LazardQuotient : (%,%,NonNegativeInteger) -> %
+   if R has INTDOM
+ LazardQuotient2 : (%,%,%,NonNegativeInteger) -> %
+   if R has INTDOM
+ nextsubResultant2 : (%,%,%,%) -> % if R has INTDOM
+ resultant : (%,%) -> % if R has INTDOM
+ subResultantChain : (%,%) -> List % if R has INTDOM
+ subResultantGcd : (%,%) -> % if R has INTDOM
+\end{verbatim}
+
+These are implemented by this category:
+\begin{verbatim}
+ coerce : % -> OutputForm             
+ coerce : % -> Polynomial R if V has KONVERT SYMBOL
+ convert : % -> String
+   if R has RETRACT INT 
+   and V has KONVERT SYMBOL
+ convert : % -> Polynomial R if V has KONVERT SYMBOL
+ convert : Polynomial R -> % if V has KONVERT SYMBOL
+ convert : Polynomial Integer -> %
+   if not has(R,Algebra Fraction Integer) 
+   and R has ALGEBRA INT 
+   and V has KONVERT SYMBOL 
+   or R has ALGEBRA FRAC INT 
+   and V has KONVERT SYMBOL
+ convert : Polynomial Fraction Integer -> %
+   if R has ALGEBRA FRAC INT 
+   and V has KONVERT SYMBOL
+ deepestInitial : % -> %
+ deepestTail : % -> %                 
+ exactQuotient : (%,R) -> % if R has INTDOM
+ exactQuotient : (%,%) -> % if R has INTDOM
+ exactQuotient! : (%,%) -> % if R has INTDOM
+ gcd : (R,%) -> R if R has GCDDOM
+ head : % -> %
+ headReduce : (%,%) -> %              
+ headReduced? : (%,List %) -> Boolean
+ headReduced? : (%,%) -> Boolean
+ infRittWu? : (%,%) -> Boolean        
+ init : % -> %
+ initiallyReduce : (%,%) -> %         
+ initiallyReduced? : (%,%) -> Boolean
+ initiallyReduced? : (%,List %) -> Boolean
+ iteratedInitials : % -> List %
+ lazyPremWithDefault : (%,%) -> 
+   Record(coef: %,gap: NonNegativeInteger,remainder: %)
+ lazyPremWithDefault : (%,%,V) -> 
+   Record(coef: %,gap: NonNegativeInteger,remainder: %)
+ lazyPquo : (%,%) -> %                
+ lazyPquo : (%,%,V) -> %
+ lazyPrem : (%,%,V) -> %
+ lazyPrem : (%,%) -> %                
+ lazyPseudoDivide : (%,%) -> 
+   Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %)
+ lazyPseudoDivide : (%,%,V) -> 
+   Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %)
+ lazyResidueClass : (%,%) -> 
+   Record(polnum: %,polden: %,power: NonNegativeInteger)
+ leadingCoefficient : (%,V) -> %
+ leastMonomial : % -> %               
+ mainCoefficients : % -> List %
+ mainContent : % -> % if R has GCDDOM
+ mainMonomial : % -> %                
+ mainMonomials : % -> List %
+ mainPrimitivePart : % -> % if R has GCDDOM
+ mainSquareFreePart : % -> % if R has GCDDOM
+ mdeg : % -> NonNegativeInteger       
+ monic? : % -> Boolean                
+ monicModulo : (%,%) -> %
+ mvar : % -> V
+ normalized? : (%,%) -> Boolean       
+ normalized? : (%,List %) -> Boolean
+ pquo : (%,%) -> %                    
+ pquo : (%,%,V) -> %
+ prem : (%,%,V) -> %
+ prem : (%,%) -> %                    
+ primitivePart! : % -> % if R has GCDDOM
+ primPartElseUnitCanonical : % -> % if R has INTDOM
+ primPartElseUnitCanonical! : % -> % if R has INTDOM
+ pseudoDivide : (%,%) -> Record(quotient: %,remainder: %)
+ quasiMonic? : % -> Boolean           
+ reduced? : (%,%) -> Boolean
+ reduced? : (%,List %) -> Boolean     
+ reductum : (%,V) -> %                
+ retract : Polynomial R -> %
+   if not has(R,Algebra Fraction Integer) 
+   and not has(R,Algebra Integer) 
+   and V has KONVERT SYMBOL 
+   or not has(R,IntegerNumberSystem) 
+   and not has(R,Algebra Fraction Integer) 
+   and R has ALGEBRA INT 
+   and V has KONVERT SYMBOL 
+   or not has(R,QuotientFieldCategory Integer) 
+   and R has ALGEBRA FRAC INT 
+   and V has KONVERT SYMBOL
+ retract : Polynomial Integer -> %
+   if not has(R,Algebra Fraction Integer) 
+   and R has ALGEBRA INT 
+   and V has KONVERT SYMBOL 
+   or R has ALGEBRA FRAC INT 
+   and V has KONVERT SYMBOL
+ retract : Polynomial Fraction Integer -> %
+   if R has ALGEBRA FRAC INT and V has KONVERT SYMBOL
+ retractIfCan : Polynomial R -> Union(%,"failed")
+   if not has(R,Algebra Fraction Integer) 
+   and not has(R,Algebra Integer) 
+   and V has KONVERT SYMBOL 
+   or not has(R,IntegerNumberSystem) 
+   and not has(R,Algebra Fraction Integer) 
+   and R has ALGEBRA INT 
+   and V has KONVERT SYMBOL 
+   or not has(R,QuotientFieldCategory Integer) 
+   and R has ALGEBRA FRAC INT 
+   and V has KONVERT SYMBOL
+ retractIfCan : Polynomial Fraction Integer -> Union(%,"failed")
+   if R has ALGEBRA FRAC INT 
+   and V has KONVERT SYMBOL
+ retractIfCan : Polynomial Integer -> Union(%,"failed")
+   if not has(R,Algebra Fraction Integer) 
+   and R has ALGEBRA INT 
+   and V has KONVERT SYMBOL 
+   or R has ALGEBRA FRAC INT 
+   and V has KONVERT SYMBOL
+ RittWuCompare : (%,%) -> Union(Boolean,"failed")
+ supRittWu? : (%,%) -> Boolean
+ tail : % -> %                        
+\end{verbatim}
+
+These exports come from \refto{PolynomialCategory}(R,E,V)\hfill\\
+where R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet:
+\begin{verbatim}
+ 0 : () -> %
+ 1 : () -> %                          
+ associates? : (%,%) -> Boolean
+   if R has INTDOM
+ binomThmExpt : (%,%,NonNegativeInteger) -> %
+   if R has COMRING
+ characteristic : () -> NonNegativeInteger
+ charthRoot : % -> Union(%,"failed")
+   if and(has($,CharacteristicNonZero),
+      has(R,PolynomialFactorizationExplicit)) 
+   or R has CHARNZ
+ coefficient : (%,List V,List NonNegativeInteger) -> %
+ coefficient : (%,V,NonNegativeInteger) -> %
+ coefficient : (%,E) -> R
+ coefficients : % -> List R           
+ coerce : R -> %                      
+ coerce : Fraction Integer -> %
+   if R has RETRACT FRAC INT or R has ALGEBRA FRAC INT
+ coerce : V -> %
+ coerce : % -> % if R has INTDOM
+ coerce : Integer -> %
+ conditionP : Matrix % -> Union(Vector %,"failed")
+   if and(has($,CharacteristicNonZero),
+          has(R,PolynomialFactorizationExplicit))
+ content : % -> R if R has GCDDOM
+ content : (%,V) -> % if R has GCDDOM
+ convert : % -> Pattern Integer
+   if V has KONVERT PATTERN INT and R has KONVERT PATTERN INT
+ convert : % -> Pattern Float
+   if V has KONVERT PATTERN FLOAT and R has KONVERT PATTERN FLOAT
+ convert : % -> InputForm
+   if V has KONVERT INFORM and R has KONVERT INFORM
+ D : (%,List V) -> %                  
+ D : (%,V) -> %
+ D : (%,List V,List NonNegativeInteger) -> %
+ D : (%,V,NonNegativeInteger) -> %
+ degree : % -> E
+ degree : (%,List V) -> List NonNegativeInteger
+ degree : (%,V) -> NonNegativeInteger
+ differentiate : (%,List V,List NonNegativeInteger) -> %
+ differentiate : (%,V,NonNegativeInteger) -> %
+ differentiate : (%,List V) -> %      
+ differentiate : (%,V) -> %
+ discriminant : (%,V) -> % if R has COMRING
+ eval : (%,List Equation %) -> %
+ eval : (%,Equation %) -> %           
+ eval : (%,List %,List %) -> %        
+ eval : (%,%,%) -> %
+ eval : (%,V,R) -> %
+ eval : (%,List V,List R) -> %        
+ eval : (%,V,%) -> %
+ eval : (%,List V,List %) -> %        
+ exquo : (%,R) -> Union(%,"failed") if R has INTDOM
+ exquo : (%,%) -> Union(%,"failed") if R has INTDOM
+ factor : % -> Factored % if R has PFECAT
+ factorPolynomial : 
+   SparseUnivariatePolynomial % -> 
+     Factored SparseUnivariatePolynomial %
+      if R has PFECAT
+ factorSquareFreePolynomial : 
+   SparseUnivariatePolynomial % -> 
+     Factored SparseUnivariatePolynomial %
+       if R has PFECAT
+ gcd : (%,%) -> % if R has GCDDOM
+ gcd : List % -> % if R has GCDDOM
+ gcdPolynomial : 
+   (SparseUnivariatePolynomial %,
+    SparseUnivariatePolynomial %) -> 
+      SparseUnivariatePolynomial %
+        if R has GCDDOM
+ ground : % -> R                      
+ ground? : % -> Boolean
+ hash : % -> SingleInteger            
+ isExpt : % -> Union(Record(var: V,exponent: NonNegativeInteger),"failed")
+ isPlus : % -> Union(List %,"failed")
+ isTimes : % -> Union(List %,"failed")
+ latex : % -> String                  
+ lcm : (%,%) -> % if R has GCDDOM
+ lcm : List % -> % if R has GCDDOM
+ leadingCoefficient : % -> R          
+ leadingMonomial : % -> %
+ mainVariable : % -> Union(V,"failed")
+ map : ((R -> R),%) -> %              
+ mapExponents : ((E -> E),%) -> %
+ max : (%,%) -> % if R has ORDSET
+ min : (%,%) -> % if R has ORDSET
+ minimumDegree : % -> E
+ minimumDegree : (%,List V) -> List NonNegativeInteger
+ minimumDegree : (%,V) -> NonNegativeInteger
+ monicDivide : (%,%,V) -> Record(quotient: %,remainder: %)
+ monomial : (%,V,NonNegativeInteger) -> %
+ monomial : (%,List V,List NonNegativeInteger) -> %
+ monomial : (R,E) -> %                
+ monomial? : % -> Boolean
+ monomials : % -> List %              
+ multivariate : (SparseUnivariatePolynomial %,V) -> %
+ multivariate : (SparseUnivariatePolynomial R,V) -> %
+ numberOfMonomials : % -> NonNegativeInteger
+ one? : % -> Boolean
+ patternMatch : 
+   (%,Pattern Integer,PatternMatchResult(Integer,%)) -> 
+     PatternMatchResult(Integer,%)
+       if V has PATMAB INT and R has PATMAB INT
+ patternMatch : 
+   (%,Pattern Float,PatternMatchResult(Float,%)) -> 
+     PatternMatchResult(Float,%)
+      if V has PATMAB FLOAT and R has PATMAB FLOAT
+ pomopo! : (%,R,E,%) -> %             
+ prime? : % -> Boolean if R has PFECAT
+ primitiveMonomials : % -> List %
+ primitivePart : (%,V) -> % if R has GCDDOM
+ primitivePart : % -> % if R has GCDDOM
+ recip : % -> Union(%,"failed")
+ reducedSystem : Matrix % -> Matrix R
+ reducedSystem : (Matrix %,Vector %) ->
+    Record(mat: Matrix R,vec: Vector R)
+ reducedSystem : (Matrix %,Vector %) ->
+   Record(mat: Matrix Integer,vec: Vector Integer)
+     if R has LINEXP INT
+ reducedSystem : Matrix % -> Matrix Integer
+   if R has LINEXP INT
+ reductum : % -> %
+ resultant : (%,%,V) -> % if R has COMRING
+ retract : % -> R
+ retract : % -> Integer if R has RETRACT INT
+ retract : % -> Fraction Integer
+   if R has RETRACT FRAC INT
+ retract : % -> V                     
+ retractIfCan : % -> Union(R,"failed")
+ retractIfCan : % -> Union(Integer,"failed")
+   if R has RETRACT INT
+ retractIfCan : % -> Union(Fraction Integer,"failed")
+   if R has RETRACT FRAC INT
+ retractIfCan : % -> Union(V,"failed")
+ sample : () -> %                     
+ solveLinearPolynomialEquation : 
+   (List SparseUnivariatePolynomial %,
+    SparseUnivariatePolynomial %) -> 
+     Union(List SparseUnivariatePolynomial %,"failed")
+       if R has PFECAT
+ squareFree : % -> Factored % if R has GCDDOM
+ squareFreePart : % -> % if R has GCDDOM
+ squareFreePolynomial : 
+   SparseUnivariatePolynomial % -> 
+     Factored SparseUnivariatePolynomial %
+       if R has PFECAT
+ subtractIfCan : (%,%) -> Union(%,"failed")
+ totalDegree : (%,List V) -> NonNegativeInteger
+ totalDegree : % -> NonNegativeInteger
+ unit? : % -> Boolean if R has INTDOM
+ unitCanonical : % -> % if R has INTDOM
+ unitNormal : % -> Record(unit: %,canonical: %,associate: %)
+   if R has INTDOM
+ univariate : % -> SparseUnivariatePolynomial R
+ univariate : (%,V) -> SparseUnivariatePolynomial %
+ variables : % -> List V
+ zero? : % -> Boolean                 
+ ?+? : (%,%) -> %                     
+ ?=? : (%,%) -> Boolean
+ ?~=? : (%,%) -> Boolean
+ ?*? : (%,R) -> %                     
+ ?*? : (R,%) -> %
+ ?*? : (Fraction Integer,%) -> % if R has ALGEBRA FRAC INT
+ ?*? : (%,Fraction Integer) -> % if R has ALGEBRA FRAC INT
+ ?*? : (%,%) -> %                     
+ ?*? : (Integer,%) -> %
+ ?*? : (PositiveInteger,%) -> %       
+ ?*? : (NonNegativeInteger,%) -> %
+ ?/? : (%,R) -> % if R has FIELD
+ ?-? : (%,%) -> %
+ -? : % -> %                          
+ ?**? : (%,PositiveInteger) -> %
+ ?**? : (%,NonNegativeInteger) -> %
+ ?^? : (%,NonNegativeInteger) -> %
+ ?^? : (%,PositiveInteger) -> %       
+ ?<? : (%,%) -> Boolean if R has ORDSET
+ ?<=? : (%,%) -> Boolean if R has ORDSET
+ ?>? : (%,%) -> Boolean if R has ORDSET
+ ?>=? : (%,%) -> Boolean if R has ORDSET
+\end{verbatim}
+
+\begin{chunk}{category RPOLCAT RecursivePolynomialCategory}
+)abbrev category RPOLCAT RecursivePolynomialCategory
+++ Author: Marc Moreno Maza
+++ Date Created: 04/22/1994
+++ Date Last Updated: 14/12/1998
+++ Description:
+
+RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
+ Category == 
+  PolynomialCategory(R, E, V) with
+     mvar : $ -> V
+         ++ \axiom{mvar(p)} returns an error if \axiom{p} belongs to 
+         ++ \axiom{R}, otherwise returns its main variable w. r. t. to the 
+         ++ total ordering on the elements in \axiom{V}.
+     mdeg  : $ -> NonNegativeInteger 
+         ++ \axiom{mdeg(p)} returns an error if \axiom{p} is \axiom{0}, 
+         ++ otherwise, if \axiom{p} belongs to \axiom{R} returns \axiom{0}, 
+         ++ otherwise, returns the degree of \axiom{p} in its main variable.
+     init : $ -> $
+         ++ \axiom{init(p)} returns an error if \axiom{p} belongs to 
+         ++ \axiom{R}, otherwise returns its leading coefficient, where 
+         ++ \axiom{p} is viewed as a univariate polynomial in its main 
+         ++ variable.
+     head  : $ -> $
+         ++ \axiom{head(p)} returns \axiom{p} if \axiom{p} belongs to 
+         ++ \axiom{R}, otherwise returns its leading term (monomial in the 
+         ++ AXIOM sense), where \axiom{p} is viewed as a univariate polynomial
+         ++  in its main variable.
+     tail  : $ -> $
+         ++ \axiom{tail(p)} returns its reductum, where \axiom{p} is viewed 
+         ++ as a univariate polynomial in its main variable.
+     deepestTail : $ -> $
+         ++ \axiom{deepestTail(p)} returns \axiom{0} if \axiom{p} belongs to 
+         ++ \axiom{R}, otherwise returns tail(p), if \axiom{tail(p)} belongs 
+         ++ to  \axiom{R} or \axiom{mvar(tail(p)) < mvar(p)}, otherwise 
+         ++ returns \axiom{deepestTail(tail(p))}.
+     iteratedInitials : $ -> List $ 
+         ++ \axiom{iteratedInitials(p)} returns \axiom{[]} if \axiom{p} 
+         ++ belongs to \axiom{R}, 
+         ++ otherwise returns the list of the iterated initials of \axiom{p}.
+     deepestInitial : $ -> $ 
+         ++ \axiom{deepestInitial(p)} returns an error if \axiom{p} belongs 
+         ++ to \axiom{R}, 
+         ++ otherwise returns the last term of \axiom{iteratedInitials(p)}.
+     leadingCoefficient : ($,V) -> $
+         ++ \axiom{leadingCoefficient(p,v)} returns the leading coefficient 
+         ++ of \axiom{p}, where \axiom{p} is viewed as A univariate 
+         ++ polynomial in \axiom{v}.
+     reductum  : ($,V) -> $
+         ++ \axiom{reductum(p,v)} returns the reductum of \axiom{p}, where 
+         ++ \axiom{p} is viewed as a univariate polynomial in \axiom{v}. 
+     monic? : $ -> Boolean
+         ++ \axiom{monic?(p)} returns false if \axiom{p} belongs to \axiom{R}, 
+         ++ otherwise returns true iff \axiom{p} is monic as a univariate 
+         ++ polynomial in its main variable.
+     quasiMonic? : $ -> Boolean
+         ++ \axiom{quasiMonic?(p)} returns false if \axiom{p} belongs to 
+         ++ \axiom{R}, otherwise returns true iff the initial of \axiom{p} 
+         ++ lies in the base ring \axiom{R}.
+     mainMonomial : $ -> $ 
+         ++ \axiom{mainMonomial(p)} returns an error if \axiom{p} is 
+         ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns 
+         ++ \axiom{1}, otherwise, \axiom{mvar(p)} raised to the power 
+         ++ \axiom{mdeg(p)}.
+     leastMonomial : $ -> $ 
+         ++ \axiom{leastMonomial(p)} returns an error if \axiom{p} is 
+         ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns 
+         ++ \axiom{1}, otherwise, the monomial of \axiom{p} with lowest 
+         ++ degree, where \axiom{p} is viewed as a univariate polynomial in 
+         ++ its main variable.
+     mainCoefficients : $ -> List $ 
+         ++ \axiom{mainCoefficients(p)} returns an error if \axiom{p} is 
+         ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns 
+         ++ [p], otherwise returns the list of the coefficients of \axiom{p}, 
+         ++ where \axiom{p} is viewed as a univariate polynomial in its main 
+         ++ variable.
+     mainMonomials : $ -> List $ 
+         ++ \axiom{mainMonomials(p)} returns an error if \axiom{p} is 
+         ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns 
+         ++ [1], otherwise returns the list of the monomials of \axiom{p}, 
+         ++ where \axiom{p} is viewed as a univariate polynomial in its main 
+         ++ variable.
+     RittWuCompare : ($, $) -> Union(Boolean,"failed")
+         ++ \axiom{RittWuCompare(a,b)} returns \axiom{"failed"} if \axiom{a} 
+         ++ and \axiom{b} have same rank w.r.t. 
+         ++ Ritt and Wu Wen Tsun ordering using the refinement of Lazard, 
+         ++ otherwise returns \axiom{infRittWu?(a,b)}.
+     infRittWu?  : ($, $) -> Boolean
+         ++ \axiom{infRittWu?(a,b)} returns true if \axiom{a} is less than 
+         ++ \axiom{b} w.r.t. the Ritt and Wu Wen Tsun ordering using the 
+         ++ refinement of Lazard.
+     supRittWu? : ($, $) -> Boolean
+         ++ \axiom{supRittWu?(a,b)} returns true if \axiom{a} is greater 
+         ++ than \axiom{b} w.r.t. the Ritt and Wu Wen Tsun ordering using the 
+         ++ refinement of Lazard.
+     reduced? : ($,$) -> Boolean
+         ++ \axiom{reduced?(a,b)} returns true iff 
+         ++ \axiom{degree(a,mvar(b)) < mdeg(b)}.
+     reduced? : ($,List($)) -> Boolean
+         ++ \axiom{reduced?(q,lp)} returns true iff \axiom{reduced?(q,p)} 
+         ++ holds for every \axiom{p} in \axiom{lp}.
+     headReduced? : ($,$) -> Boolean
+         ++ \axiom{headReduced?(a,b)} returns true iff 
+         ++ \axiom{degree(head(a),mvar(b)) < mdeg(b)}.
+     headReduced? : ($,List($)) -> Boolean
+         ++ \axiom{headReduced?(q,lp)} returns true iff 
+         ++ \axiom{headReduced?(q,p)} holds for every \axiom{p} in \axiom{lp}.
+     initiallyReduced? : ($,$) -> Boolean
+         ++ \axiom{initiallyReduced?(a,b)} returns false iff there exists an 
+         ++ iterated initial of \axiom{a} which is not reduced w.r.t \axiom{b}.
+     initiallyReduced? :  ($,List($)) -> Boolean
+         ++ \axiom{initiallyReduced?(q,lp)} returns true iff 
+         ++ \axiom{initiallyReduced?(q,p)} holds for every \axiom{p} in 
+         ++ \axiom{lp}.
+     normalized? : ($,$) -> Boolean
+         ++ \axiom{normalized?(a,b)} returns true iff \axiom{a} and its 
+         ++ iterated initials have degree zero w.r.t. the main variable of 
+         ++ \axiom{b}
+     normalized? : ($,List($)) -> Boolean
+         ++ \axiom{normalized?(q,lp)} returns true iff 
+         ++ \axiom{normalized?(q,p)} holds 
+         ++ for every \axiom{p} in \axiom{lp}.
+     prem : ($, $) -> $
+         ++ \axiom{prem(a,b)} computes the pseudo-remainder of \axiom{a} by 
+         ++ \axiom{b}, both viewed as univariate polynomials in the main 
+         ++ variable of \axiom{b}.
+     pquo : ($, $) -> $
+         ++ \axiom{pquo(a,b)} computes the pseudo-quotient of \axiom{a} by 
+         ++ \axiom{b}, both viewed as univariate polynomials in the main 
+         ++ variable of \axiom{b}.
+     prem : ($, $, V) -> $
+         ++ \axiom{prem(a,b,v)} computes the pseudo-remainder of \axiom{a} 
+         ++ by \axiom{b}, both viewed as univariate polynomials in \axiom{v}.
+     pquo : ($, $, V) -> $
+         ++ \axiom{pquo(a,b,v)} computes the pseudo-quotient of \axiom{a} by 
+         ++ \axiom{b}, both viewed as univariate polynomials in \axiom{v}.
+     lazyPrem : ($, $) ->  $
+         ++ \axiom{lazyPrem(a,b)} returns the polynomial \axiom{r} reduced 
+         ++ w.r.t. \axiom{b} and such that \axiom{b} divides 
+         ++ \axiom{init(b)^e a - r} where \axiom{e} 
+         ++ is the number of steps of this pseudo-division.
+     lazyPquo : ($, $) ->  $
+         ++ \axiom{lazyPquo(a,b)} returns the polynomial \axiom{q} such that 
+         ++ \axiom{lazyPseudoDivide(a,b)} returns \axiom{[c,g,q,r]}.
+     lazyPrem : ($, $, V) -> $
+         ++ \axiom{lazyPrem(a,b,v)} returns the polynomial \axiom{r} 
+         ++ reduced w.r.t. \axiom{b} viewed as univariate polynomials in the 
+         ++ variable \axiom{v} such that \axiom{b} divides 
+         ++ \axiom{init(b)^e a - r} where \axiom{e} is the number of steps of 
+         ++ this pseudo-division.
+     lazyPquo : ($, $, V) ->  $
+         ++ \axiom{lazyPquo(a,b,v)} returns the polynomial \axiom{q} such that 
+         ++ \axiom{lazyPseudoDivide(a,b,v)} returns \axiom{[c,g,q,r]}.
+     lazyPremWithDefault : ($, $) -> _
+       Record (coef : $, gap : NonNegativeInteger, remainder : $)
+         ++ \axiom{lazyPremWithDefault(a,b)} returns \axiom{[c,g,r]}
+         ++ such that \axiom{r = lazyPrem(a,b)} and 
+         ++ \axiom{(c**g)*r = prem(a,b)}.
+     lazyPremWithDefault : ($, $, V) -> _
+       Record (coef : $, gap : NonNegativeInteger, remainder : $)
+         ++ \axiom{lazyPremWithDefault(a,b,v)} returns \axiom{[c,g,r]} 
+         ++ such that \axiom{r = lazyPrem(a,b,v)} and 
+         ++ \axiom{(c**g)*r = prem(a,b,v)}.
+     lazyPseudoDivide : ($,$) -> _
+       Record(coef:$, gap: NonNegativeInteger,quotient:$, remainder:$)
+         ++ \axiom{lazyPseudoDivide(a,b)} returns \axiom{[c,g,q,r]} 
+         ++ such that \axiom{[c,g,r] = lazyPremWithDefault(a,b)} and
+         ++ \axiom{q} is the pseudo-quotient computed in this lazy 
+         ++ pseudo-division.
+     lazyPseudoDivide : ($,$,V) -> _
+       Record(coef:$, gap:NonNegativeInteger, quotient:$, remainder: $)
+         ++ \axiom{lazyPseudoDivide(a,b,v)} returns \axiom{[c,g,q,r]} such 
+         ++ that  \axiom{r = lazyPrem(a,b,v)}, \axiom{(c**g)*r = prem(a,b,v)} 
+         ++ and \axiom{q} is the pseudo-quotient computed in this lazy 
+         ++ pseudo-division.
+     pseudoDivide : ($, $) -> Record (quotient : $, remainder : $)
+         ++ \axiom{pseudoDivide(a,b)} computes \axiom{[pquo(a,b),prem(a,b)]}, 
+         ++ both polynomials viewed as univariate polynomials in the main 
+         ++ variable of \axiom{b}, if \axiom{b} is not a constant polynomial.
+     monicModulo : ($, $) -> $ 
+         ++ \axiom{monicModulo(a,b)} computes \axiom{a mod b}, if \axiom{b} is 
+         ++ monic as univariate polynomial in its main variable.
+     lazyResidueClass : ($,$) -> _
+      Record(polnum:$, polden:$, power:NonNegativeInteger)
+         ++ \axiom{lazyResidueClass(a,b)} returns \axiom{[p,q,n]} where 
+         ++ \axiom{p / q**n} represents the residue class of \axiom{a} 
+         ++ modulo \axiom{b} and \axiom{p} is reduced w.r.t. \axiom{b} and 
+         ++ \axiom{q} is \axiom{init(b)}.
+     headReduce: ($, $) ->  $
+         ++ \axiom{headReduce(a,b)} returns a polynomial \axiom{r} such that 
+         ++ \axiom{headReduced?(r,b)} holds and there exists an integer 
+         ++ \axiom{e} such that \axiom{init(b)^e a - r} is zero modulo 
+         ++ \axiom{b}.
+     initiallyReduce: ($, $) ->  $
+         ++ \axiom{initiallyReduce(a,b)} returns a polynomial \axiom{r} such 
+         ++ that \axiom{initiallyReduced?(r,b)} holds and there exists an 
+         ++ integer \axiom{e} such that \axiom{init(b)^e a - r} is zero 
+         ++ modulo \axiom{b}.
+
+     if (V has ConvertibleTo(Symbol))
+     then 
+       CoercibleTo(Polynomial R)
+       ConvertibleTo(Polynomial R)
+       if R has Algebra Fraction Integer
+         then 
+           retractIfCan : Polynomial Fraction Integer -> Union($,"failed")
+               ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of 
+               ++ the current domain if all its variables belong to \axiom{V}.
+           retract : Polynomial Fraction Integer -> $
+               ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
+               ++ current domain if \axiom{retractIfCan(p)} does not return 
+               ++ "failed", otherwise an error is produced.
+           convert : Polynomial Fraction Integer -> $
+               ++ \axiom{convert(p)} returns the same as \axiom{retract(p)}.
+           retractIfCan : Polynomial Integer -> Union($,"failed")
+               ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of 
+               ++ the current domain if all its variables belong to \axiom{V}.
+           retract : Polynomial Integer -> $
+               ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
+               ++ current domain if \axiom{retractIfCan(p)} does not return 
+               ++ "failed", otherwise an error is produced.
+           convert : Polynomial Integer -> $
+               ++ \axiom{convert(p)} returns the same as \axiom{retract(p)}
+           if not (R has QuotientFieldCategory(Integer))
+             then
+               retractIfCan : Polynomial R -> Union($,"failed")
+                 ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element 
+                 ++ of the current domain if all its variables belong to 
+                 ++ \axiom{V}.
+               retract : Polynomial R -> $
+                 ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
+                 ++ current domain if \axiom{retractIfCan(p)} does not 
+                 ++ return "failed", otherwise an error is produced.
+       if (R has Algebra Integer) and not(R has Algebra Fraction Integer)
+         then 
+           retractIfCan : Polynomial Integer -> Union($,"failed")
+               ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of 
+               ++ the current domain if all its variables belong to \axiom{V}.
+           retract : Polynomial Integer -> $
+               ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
+               ++ current domain if \axiom{retractIfCan(p)} does not return 
+               ++ "failed", otherwise an error is produced.
+           convert : Polynomial Integer -> $
+               ++ \axiom{convert(p)} returns the same as \axiom{retract(p)}.
+           if not (R has IntegerNumberSystem)
+             then
+               retractIfCan : Polynomial R -> Union($,"failed")
+                 ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element 
+                 ++ of the current domain if all its variables belong to 
+                 ++ \axiom{V}.
+               retract : Polynomial R -> $
+                 ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
+                 ++ current domain if \axiom{retractIfCan(p)} does not 
+                 ++ return "failed", otherwise an error is produced.
+       if not(R has Algebra Integer) and not(R has Algebra Fraction Integer)
+         then 
+           retractIfCan : Polynomial R -> Union($,"failed")
+             ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of 
+             ++ the current domain if all its variables belong to \axiom{V}.
+           retract : Polynomial R -> $
+             ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
+             ++ current domain if \axiom{retractIfCan(p)} does not return 
+             ++ "failed", otherwise an error is produced.
+       convert : Polynomial R -> $
+         ++ \axiom{convert(p)} returns \axiom{p} as an element of the current 
+         ++ domain if all its variables belong to \axiom{V}, otherwise an 
+         ++ error is produced.
+
+       if R has RetractableTo(Integer)
+       then
+         ConvertibleTo(String)
+
+     if R has IntegralDomain
+     then
+       primPartElseUnitCanonical : $ -> $
+           ++ \axiom{primPartElseUnitCanonical(p)} returns 
+           ++ \axiom{primitivePart(p)} if \axiom{R} is a gcd-domain, 
+           ++ otherwise \axiom{unitCanonical(p)}.
+       primPartElseUnitCanonical! : $ -> $
+           ++ \axiom{primPartElseUnitCanonical!(p)} replaces  \axiom{p} 
+           ++ by \axiom{primPartElseUnitCanonical(p)}.
+       exactQuotient : ($,R) -> $
+           ++ \axiom{exactQuotient(p,r)} computes the exact quotient of 
+           ++ \axiom{p} by \axiom{r}, which is assumed to be a divisor of 
+           ++ \axiom{p}. No error is returned if this exact quotient fails!
+       exactQuotient! : ($,R) -> $
+           ++ \axiom{exactQuotient!(p,r)} replaces \axiom{p} by 
+           ++ \axiom{exactQuotient(p,r)}.
+       exactQuotient : ($,$) -> $
+           ++ \axiom{exactQuotient(a,b)} computes the exact quotient of 
+           ++ \axiom{a} by \axiom{b}, which is assumed to be a divisor of 
+           ++ \axiom{a}. No error is returned if this exact quotient fails!
+       exactQuotient! : ($,$) -> $
+           ++ \axiom{exactQuotient!(a,b)} replaces \axiom{a} by 
+           ++ \axiom{exactQuotient(a,b)}
+       subResultantGcd : ($, $) -> $ 
+           ++ \axiom{subResultantGcd(a,b)} computes a gcd of \axiom{a} and 
+           ++ \axiom{b} where \axiom{a} and \axiom{b} are assumed to have the 
+           ++ same main variable \axiom{v} and are viewed as univariate 
+           ++ polynomials in \axiom{v} with coefficients in the fraction 
+           ++ field of the polynomial ring generated by their other variables 
+           ++ over \axiom{R}.
+       extendedSubResultantGcd : ($, $) -> _
+        Record (gcd : $, coef1 : $, coef2 : $)
+           ++ \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[ca,cb,r]} 
+           ++ such that \axiom{r} is \axiom{subResultantGcd(a,b)} and we have
+           ++ \axiom{ca * a + cb * cb = r} .
+       halfExtendedSubResultantGcd1: ($, $) -> Record (gcd : $, coef1 : $)
+           ++ \axiom{halfExtendedSubResultantGcd1(a,b)} returns \axiom{[g,ca]}
+           ++ if \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[g,ca,cb]}
+           ++ otherwise produces an error.
+       halfExtendedSubResultantGcd2: ($, $) -> Record (gcd : $, coef2 : $)
+           ++ \axiom{halfExtendedSubResultantGcd2(a,b)} returns \axiom{[g,cb]}
+           ++ if \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[g,ca,cb]}
+           ++ otherwise produces an error.
+       resultant  : ($, $) -> $ 
+           ++ \axiom{resultant(a,b)} computes the resultant of \axiom{a} and 
+           ++ \axiom{b} where \axiom{a} and \axiom{b} are assumed to have the 
+           ++ same main variable \axiom{v} and are viewed as univariate 
+           ++ polynomials in \axiom{v}.
+       subResultantChain : ($, $) -> List $
+           ++ \axiom{subResultantChain(a,b)}, where \axiom{a} and \axiom{b} 
+           ++ are not contant polynomials with the same main variable, returns
+           ++ the subresultant chain of \axiom{a} and \axiom{b}.
+       lastSubResultant: ($, $) -> $
+           ++ \axiom{lastSubResultant(a,b)} returns the last non-zero 
+           ++ subresultant of \axiom{a} and \axiom{b} where \axiom{a} and 
+           ++ \axiom{b} are assumed to have the same main variable \axiom{v} 
+           ++ and are viewed as univariate polynomials in \axiom{v}.
+       LazardQuotient: ($, $, NonNegativeInteger) -> $
+           ++ \axiom{LazardQuotient(a,b,n)} returns \axiom{a**n exquo b**(n-1)}
+           ++ assuming that this quotient does not fail.
+       LazardQuotient2: ($, $, $, NonNegativeInteger) -> $
+           ++ \axiom{LazardQuotient2(p,a,b,n)} returns 
+           ++ \axiom{(a**(n-1) * p) exquo b**(n-1)}
+           ++ assuming that this quotient does not fail.
+       next_subResultant2: ($, $, $, $) -> $
+           ++ \axiom{nextsubResultant2(p,q,z,s)} is the multivariate version
+           ++ of the operation 
+           ++ next_sousResultant2 from PseudoRemainderSequence from
+           ++ the \axiomType{PseudoRemainderSequence} constructor.
+
+     if R has GcdDomain
+     then
+       gcd : (R,$) -> R
+           ++ \axiom{gcd(r,p)} returns the gcd of \axiom{r} and the content 
+           ++ of \axiom{p}.
+       primitivePart! : $ -> $
+           ++ \axiom{primitivePart!(p)} replaces \axiom{p}  by its primitive 
+           ++ part.
+       mainContent : $ -> $
+           ++ \axiom{mainContent(p)} returns the content of \axiom{p} viewed 
+           ++ as a univariate polynomial in its main variable and with 
+           ++ coefficients in the polynomial ring generated by its other 
+           ++ variables over \axiom{R}.
+       mainPrimitivePart : $ -> $
+           ++ \axiom{mainPrimitivePart(p)} returns the primitive part of 
+           ++ \axiom{p} viewed as a univariate polynomial in its main 
+           ++ variable and with coefficients in the polynomial ring generated 
+           ++ by its other variables over \axiom{R}.
+       mainSquareFreePart : $ -> $
+           ++ \axiom{mainSquareFreePart(p)} returns the square free part of 
+           ++ \axiom{p} viewed as a univariate polynomial in its main 
+           ++ variable and with coefficients in the polynomial ring 
+           ++ generated by its other variables over \axiom{R}.
+
+ add
+     O ==> OutputForm
+     NNI ==> NonNegativeInteger
+     INT ==> Integer
+
+     exactQuo : (R,R) -> R
+
+     coerce(p:$):O ==
+       ground? (p) => (ground(p))::O
+       if (((ip := init(p))) = 1)
+         then
+           if zero?((tp := tail(p)))
+             then
+               if (((dp := mdeg(p))) = 1)
+                 then
+                   return((mvar(p))::O)
+                 else
+                   return(((mvar(p))::O **$O (dp::O)))
+             else
+               if (((dp := mdeg(p))) = 1)
+                 then
+                   return((mvar(p))::O +$O (tp::O))
+                 else
+                   return(((mvar(p))::O **$O (dp::O)) +$O (tp::O))
+          else
+           if zero?((tp := tail(p)))
+             then
+               if (((dp := mdeg(p))) = 1)
+                 then
+                   return((ip::O) *$O  (mvar(p))::O)
+                 else
+                   return((ip::O) *$O ((mvar(p))::O **$O (dp::O)))
+             else
+               if ((mdeg(p)) = 1)
+                 then
+                   return(((ip::O) *$O  (mvar(p))::O) +$O (tp::O))
+       ((ip)::O *$O ((mvar(p))::O **$O ((mdeg(p)::O))) +$O (tail(p)::O))
+
+     mvar p ==
+       ground?(p) => error"Error in mvar from RPOLCAT : #1 is constant."
+       mainVariable(p)::V
+
+     mdeg p == 
+       ground?(p) => 0$NNI
+       degree(p,mainVariable(p)::V)
+
+     init p ==
+       ground?(p) => error"Error in mvar from RPOLCAT : #1 is constant."
+       v := mainVariable(p)::V
+       coefficient(p,v,degree(p,v))
+
+     leadingCoefficient (p,v) ==
+       zero? (d := degree(p,v)) => p
+       coefficient(p,v,d)
+
+     head p ==
+       ground? p => p
+       v := mainVariable(p)::V
+       d := degree(p,v)
+       monomial(coefficient(p,v,d),v,d)
+
+     reductum(p,v) ==
+       zero? (d := degree(p,v)) => 0$$
+       p - monomial(coefficient(p,v,d),v,d)
+
+     tail p ==
+       ground? p => 0$$
+       p - head(p)
+
+     deepestTail p ==
+       ground? p => 0$$
+       ground? tail(p) => tail(p)
+       mvar(p) > mvar(tail(p)) => tail(p)
+       deepestTail(tail(p))
+
+     iteratedInitials p == 
+       ground? p => []
+       p := init(p)
+       cons(p,iteratedInitials(p))
+
+     localDeepestInitial (p : $) : $ == 
+       ground? p => p
+       localDeepestInitial init p
+
+     deepestInitial p == 
+       ground? p => _
+         error"Error in deepestInitial from RPOLCAT : #1 is constant."
+       localDeepestInitial init p
+
+     monic? p ==
+       ground? p => false
+       (recip(init(p))$$ case $)@Boolean
+
+     quasiMonic?  p ==
+       ground? p => false
+       ground?(init(p))
+
+     mainMonomial p == 
+       zero? p => error"Error in mainMonomial from RPOLCAT : #1 is zero"
+       ground? p => 1$$
+       v := mainVariable(p)::V
+       monomial(1$$,v,degree(p,v))
+
+     leastMonomial p == 
+       zero? p => error"Error in leastMonomial from RPOLCAT : #1 is zero"
+       ground? p => 1$$
+       v := mainVariable(p)::V
+       monomial(1$$,v,minimumDegree(p,v))
+
+     mainCoefficients p == 
+       zero? p => error"Error in mainCoefficients from RPOLCAT : #1 is zero"
+       ground? p => [p]
+       v := mainVariable(p)::V
+       coefficients(univariate(p,v)@SparseUnivariatePolynomial($))
+
+     mainMonomials p == 
+       zero? p => error"Error in mainMonomials from RPOLCAT : #1 is zero"
+       ground? p => [1$$]
+       v := mainVariable(p)::V
+       lm := monomials(univariate(p,v)@SparseUnivariatePolynomial($))
+       [monomial(1$$,v,degree(m)) for m in lm]
+
+     RittWuCompare (a,b) ==
+       (ground? b and  ground? a) => "failed"::Union(Boolean,"failed")
+       ground? b => false::Union(Boolean,"failed")
+       ground? a => true::Union(Boolean,"failed")
+       mvar(a) < mvar(b) => true::Union(Boolean,"failed")
+       mvar(a) > mvar(b) => false::Union(Boolean,"failed")
+       mdeg(a) < mdeg(b) => true::Union(Boolean,"failed")
+       mdeg(a) > mdeg(b) => false::Union(Boolean,"failed")
+       lc := RittWuCompare(init(a),init(b))
+       lc case Boolean => lc
+       RittWuCompare(tail(a),tail(b))
+
+     infRittWu? (a,b) ==
+       lc : Union(Boolean,"failed") := RittWuCompare(a,b)
+       lc case Boolean => lc::Boolean
+       false
+       
+     supRittWu? (a,b) ==
+       infRittWu? (b,a)
+
+     prem (a:$, b:$)  : $ == 
+       cP := lazyPremWithDefault (a,b)
+       ((cP.coef) ** (cP.gap)) * cP.remainder
+
+     pquo (a:$, b:$)  : $ == 
+       cPS := lazyPseudoDivide (a,b)
+       c := (cPS.coef) ** (cPS.gap)
+       c * cPS.quotient
+
+     prem (a:$, b:$, v:V) : $ ==
+       cP := lazyPremWithDefault (a,b,v)
+       ((cP.coef) ** (cP.gap)) * cP.remainder  
+
+     pquo (a:$, b:$, v:V)  : $ == 
+       cPS := lazyPseudoDivide (a,b,v)
+       c := (cPS.coef) ** (cPS.gap)
+       c * cPS.quotient     
+
+     lazyPrem (a:$, b:$) : $ ==
+       (not ground?(b)) and (monic?(b)) => monicModulo(a,b)
+       (lazyPremWithDefault (a,b)).remainder
+       
+     lazyPquo (a:$, b:$) : $ ==
+       (lazyPseudoDivide (a,b)).quotient
+
+     lazyPrem (a:$, b:$, v:V) : $ ==
+       zero? b => _
+         error"Error in lazyPrem : ($,$,V) -> $ from RPOLCAT : #2 is zero"
+       ground?(b) => 0$$
+       (v = mvar(b)) => lazyPrem(a,b)
+       dbv : NNI := degree(b,v)
+       zero? dbv => 0$$
+       dav : NNI  := degree(a,v)
+       zero? dav => a
+       test : INT := dav::INT - dbv 
+       lcbv : $ := leadingCoefficient(b,v)
+       while not zero?(a) and not negative?(test) repeat
+         lcav := leadingCoefficient(a,v)
+         term := monomial(lcav,v,test::NNI)
+         a := lcbv * a - term * b
+         test := degree(a,v)::INT - dbv 
+       a
+         
+     lazyPquo (a:$, b:$, v:V) : $ ==
+       (lazyPseudoDivide (a,b,v)).quotient
+
+     headReduce (a:$,b:$) == 
+       ground? b => error _
+        "Error in headReduce : ($,$) -> Boolean from TSETCAT : #2 is constant"
+       ground? a => a
+       mvar(a) = mvar(b) => lazyPrem(a,b)
+       while not reduced?((ha := head a),b) repeat
+         lrc := lazyResidueClass(ha,b)
+         if zero? tail(a)
+           then
+             a := lrc.polnum
+           else
+             a := lrc.polnum +  (lrc.polden)**(lrc.power) * tail(a)
+       a
+
+     initiallyReduce(a:$,b:$) ==
+       ground? b => error _
+   "Error in initiallyReduce : ($,$) -> Boolean from TSETCAT : #2 is constant"
+       ground? a => a
+       v := mvar(b)
+       mvar(a) = v => lazyPrem(a,b)
+       ia := a
+       ma := 1$$
+       ta := 0$$
+       while (not ground?(ia)) and (mvar(ia) >= mvar(b)) repeat
+         if (mvar(ia) = mvar(b)) and (mdeg(ia) >= mdeg(b))
+           then
+             iamodb := lazyResidueClass(ia,b)
+             ia := iamodb.polnum
+             if not zero? ta
+               then
+                 ta :=  (iamodb.polden)**(iamodb.power) * ta
+         if zero? ia 
+           then 
+             ia := ta
+             ma := 1$$
+             ta := 0$$
+           else
+             if not ground?(ia)
+               then
+                 ta := tail(ia) * ma + ta
+                 ma := mainMonomial(ia) * ma
+                 ia := init(ia)
+       ia * ma + ta
+
+     lazyPremWithDefault (a,b) == 
+       ground?(b) => error _
+         "Error in lazyPremWithDefault from RPOLCAT : #2 is constant"
+       ground?(a) => [1$$,0$NNI,a]
+       xa := mvar a
+       xb := mvar b
+       xa < xb => [1$$,0$NNI,a]
+       lcb : $ := init b 
+       db : NNI := mdeg b
+       test : INT := degree(a,xb)::INT - db
+       delta : INT := max(test + 1$INT, 0$INT) 
+       if xa = xb 
+         then
+           b := tail b
+           while not zero?(a) and not negative?(test) repeat 
+             term := monomial(init(a),xb,test::NNI)
+             a := lcb * tail(a) - term * b 
+             delta := delta - 1$INT 
+             test := degree(a,xb)::INT - db
+         else 
+           while not zero?(a) and not negative?(test) repeat 
+             term := monomial(leadingCoefficient(a,xb),xb,test::NNI)
+             a := lcb * a - term * b
+             delta := delta - 1$INT 
+             test := degree(a,xb)::INT - db
+       [lcb, (delta::NNI), a]
+
+     lazyPremWithDefault (a,b,v) == 
+       zero? b =>  error _
+        "Error in lazyPremWithDefault : ($,$,V) -> $ from RPOLCAT : #2 is zero"
+       ground?(b) => [b,1$NNI,0$$]
+       (v = mvar(b)) => lazyPremWithDefault(a,b)
+       dbv : NNI := degree(b,v)
+       zero? dbv => [b,1$NNI,0$$]
+       dav : NNI  := degree(a,v)
+       zero? dav => [1$$,0$NNI,a]
+       test : INT := dav::INT - dbv 
+       delta : INT := max(test + 1$INT, 0$INT) 
+       lcbv : $ := leadingCoefficient(b,v)
+       while not zero?(a) and not negative?(test) repeat
+         lcav := leadingCoefficient(a,v)
+         term := monomial(lcav,v,test::NNI)
+         a := lcbv * a - term * b
+         delta := delta - 1$INT 
+         test := degree(a,v)::INT - dbv 
+       [lcbv, (delta::NNI), a]
+
+     pseudoDivide (a,b) == 
+       cPS := lazyPseudoDivide (a,b)
+       c := (cPS.coef) ** (cPS.gap)
+       [c * cPS.quotient, c * cPS.remainder]
+
+     lazyPseudoDivide (a,b) == 
+       ground?(b) => error _
+          "Error in lazyPseudoDivide from RPOLCAT : #2 is constant"
+       ground?(a) => [1$$,0$NNI,0$$,a]
+       xa := mvar a 
+       xb := mvar b
+       xa < xb => [1$$,0$NNI,0$$, a]
+       lcb : $ := init b 
+       db : NNI := mdeg b
+       q := 0$$
+       test : INT := degree(a,xb)::INT - db
+       delta : INT := max(test + 1$INT, 0$INT) 
+       if xa = xb 
+         then
+           b := tail b
+           while not zero?(a) and not negative?(test) repeat 
+             term := monomial(init(a),xb,test::NNI)
+             a := lcb * tail(a) - term * b 
+             q := lcb * q + term
+             delta := delta - 1$INT 
+             test := degree(a,xb)::INT - db
+         else 
+           while not zero?(a) and not negative?(test) repeat 
+             term := monomial(leadingCoefficient(a,xb),xb,test::NNI)
+             a := lcb * a - term * b
+             q := lcb * q + term
+             delta := delta - 1$INT 
+             test := degree(a,xb)::INT - db
+       [lcb, (delta::NNI), q, a]
+
+     lazyPseudoDivide (a,b,v) == 
+       zero? b =>  error _
+         "Error in lazyPseudoDivide : ($,$,V) -> $ from RPOLCAT : #2 is zero"
+       ground?(b) => [b,1$NNI,a,0$$]
+       (v = mvar(b)) => lazyPseudoDivide(a,b)
+       dbv : NNI := degree(b,v)
+       zero? dbv => [b,1$NNI,a,0$$]
+       dav : NNI  := degree(a,v)
+       zero? dav => [1$$,0$NNI,0$$, a]
+       test : INT := dav::INT - dbv 
+       delta : INT := max(test + 1$INT, 0$INT) 
+       lcbv : $ := leadingCoefficient(b,v)
+       q := 0$$
+       while not zero?(a) and not negative?(test) repeat
+         lcav := leadingCoefficient(a,v)
+         term := monomial(lcav,v,test::NNI)
+         a := lcbv * a - term * b
+         q := lcbv * q + term
+         delta := delta - 1$INT 
+         test := degree(a,v)::INT - dbv 
+       [lcbv, (delta::NNI), q, a]
+
+     monicModulo (a,b) == 
+       ground?(b) => error"Error in monicModulo from RPOLCAT : #2 is constant"
+       rec : Union($,"failed") 
+       rec := recip((ib := init(b)))$$
+       (rec case "failed")@Boolean => error _
+         "Error in monicModulo from RPOLCAT : #2 is not monic"
+       ground? a => a
+       ib * ((lazyPremWithDefault ((rec::$) * a,(rec::$) * b)).remainder)
+
+     lazyResidueClass(a,b) ==
+       zero? b => [a,1$$,0$NNI]
+       ground? b => [0$$,1$$,0$NNI]
+       ground? a => [a,1$$,0$NNI]
+       xa := mvar a
+       xb := mvar b
+       xa < xb => [a,1$$,0$NNI]
+       monic?(b) => [monicModulo(a,b),1$$,0$NNI]
+       lcb : $ := init b 
+       db : NNI := mdeg b
+       test : INT := degree(a,xb)::INT - db
+       pow : NNI := 0
+       if xa = xb 
+         then
+           b := tail b
+           while not zero?(a) and not negative?(test) repeat 
+             term := monomial(init(a),xb,test::NNI)
+             a := lcb * tail(a) - term * b 
+             pow := pow + 1$NNI
+             test := degree(a,xb)::INT - db
+         else 
+           while not zero?(a) and not negative?(test) repeat 
+             term := monomial(leadingCoefficient(a,xb),xb,test::NNI)
+             a := lcb * a - term * b
+             pow := pow + 1$NNI
+             test := degree(a,xb)::INT - db
+       [a,lcb,pow]
+
+     reduced? (a:$,b:$) : Boolean ==
+       degree(a,mvar(b)) < mdeg(b)
+
+     reduced? (p:$, lq : List($)) : Boolean ==
+       ground? p => true
+       while (not empty? lq) and (reduced?(p, first lq)) repeat
+         lq := rest lq
+       empty? lq
+
+     headReduced? (a:$,b:$) : Boolean ==
+       reduced?(head(a),b)
+
+     headReduced? (p:$, lq : List($)) : Boolean ==
+       reduced?(head(p),lq)
+
+     initiallyReduced? (a:$,b:$) : Boolean ==
+       ground? b => error _
+   "Error in initiallyReduced? : ($,$) -> Bool. from RPOLCAT : #2 is constant"
+       ground?(a) => true
+       mvar(a) < mvar(b) => true
+       (mvar(a) = mvar(b)) => reduced?(a,b)
+       initiallyReduced?(init(a),b)
+
+     initiallyReduced? (p:$, lq : List($)) : Boolean ==
+       ground? p => true
+       while (not empty? lq) and (initiallyReduced?(p, first lq)) repeat
+         lq := rest lq
+       empty? lq
+
+     normalized?(a:$,b:$) : Boolean ==
+       ground? b => error _
+      "Error in  normalized? : ($,$) -> Boolean from TSETCAT : #2 is constant"
+       ground? a => true
+       mvar(a) < mvar(b) => true
+       (mvar(a) = mvar(b)) => false
+       normalized?(init(a),b)
+
+     normalized? (p:$, lq : List($)) : Boolean ==
+       while (not empty? lq) and (normalized?(p, first lq)) repeat
+         lq := rest lq
+       empty? lq       
+
+     if R has IntegralDomain
+     then
+
+       if R has EuclideanDomain
+         then
+           exactQuo(r:R,s:R):R ==
+             r quo$R s
+         else
+           exactQuo(r:R,s:R):R ==
+             (r exquo$R s)::R
+
+       exactQuotient (p:$,r:R) ==
+         (p exquo$$ r)::$
+
+       exactQuotient (a:$,b:$) ==
+         ground? b => exactQuotient(a,ground(b))
+         (a exquo$$ b)::$
+
+       exactQuotient! (a:$,b:$) ==
+         ground? b => exactQuotient!(a,ground(b))
+         a := (a exquo$$ b)::$
+
+       if (R has GcdDomain) and not(R has Field)
+       then
+
+         primPartElseUnitCanonical p ==
+           primitivePart p
+
+         primitivePart! p ==
+           zero? p => p
+           if ((cp := content(p)) = 1)
+             then
+               p := unitCanonical p
+             else
+               p := unitCanonical exactQuotient!(p,cp) 
+           p
+
+         primPartElseUnitCanonical! p ==
+           primitivePart! p
+
+       else
+         primPartElseUnitCanonical p ==
+           unitCanonical p
+
+         primPartElseUnitCanonical! p ==
+           p := unitCanonical p
+
+
+     if R has GcdDomain
+     then
+
+       gcd(r:R,p:$):R ==
+         (r = 1) => r
+         zero? p => r
+         ground? p => gcd(r,ground(p))$R
+         gcd(gcd(r,init(p)),tail(p))
+
+       mainContent p ==
+         zero? p => p
+         "gcd"/mainCoefficients(p)
+
+       mainPrimitivePart p ==
+         zero? p => p
+         (unitNormal((p exquo$$ mainContent(p))::$)).canonical
+
+       mainSquareFreePart p ==
+         ground? p => p
+         v := mainVariable(p)::V
+         sfp : SparseUnivariatePolynomial($)
+         sfp := squareFreePart(univariate(p,v)@SparseUnivariatePolynomial($))
+         multivariate(sfp,v)
+
+     if (V has ConvertibleTo(Symbol))
+       then
+
+         PR ==> Polynomial R
+         PQ ==> Polynomial Fraction Integer
+         PZ ==> Polynomial Integer
+         IES ==> IndexedExponents(Symbol)
+         Q ==> Fraction Integer
+         Z ==> Integer
+
+         convert(p:$) : PR ==
+           ground? p => (ground(p)$$)::PR
+           v : V := mvar(p)
+           d : NNI := mdeg(p)
+           convert(init(p))@PR *$PR _
+                        ((convert(v)@Symbol)::PR)**d +$PR convert(tail(p))@PR
+
+         coerce(p:$) : PR ==
+           convert(p)@PR
+
+         localRetract : PR -> $
+         localRetractPQ : PQ -> $
+         localRetractPZ : PZ -> $
+         localRetractIfCan : PR -> Union($,"failed")
+         localRetractIfCanPQ : PQ -> Union($,"failed")
+         localRetractIfCanPZ : PZ -> Union($,"failed")
+
+         if V has Finite
+           then 
+
+             sizeV : NNI := size()$V
+             lv : List Symbol
+             lv := _
+               [convert(index(i::PositiveInteger)$V)@Symbol for i in 1..sizeV]
+
+             localRetract(p : PR) : $ ==
+               ground? p => (ground(p)$PR)::$
+               mvp : Symbol := (mainVariable(p)$PR)::Symbol
+               d : NNI
+               imvp : PositiveInteger := _
+                             (position(mvp,lv)$(List Symbol))::PositiveInteger 
+               vimvp : V := index(imvp)$V
+               xvimvp,c : $ 
+               newp := 0$$
+               while (not zero? (d := degree(p,mvp))) repeat
+                 c := localRetract(coefficient(p,mvp,d)$PR)
+                 xvimvp := monomial(c,vimvp,d)$$
+                 newp := newp +$$ xvimvp
+                 p := p -$PR monomial(coefficient(p,mvp,d)$PR,mvp,d)$PR
+               newp +$$ localRetract(p)
+
+             if R has Algebra Fraction Integer
+               then 
+                 localRetractPQ(pq:PQ):$ ==
+                   ground? pq => ((ground(pq)$PQ)::R)::$
+                   mvp : Symbol := (mainVariable(pq)$PQ)::Symbol
+                   d : NNI
+                   imvp : PositiveInteger := _
+                             (position(mvp,lv)$(List Symbol))::PositiveInteger 
+                   vimvp : V := index(imvp)$V
+                   xvimvp,c : $ 
+                   newp := 0$$
+                   while (not zero? (d := degree(pq,mvp))) repeat
+                     c := localRetractPQ(coefficient(pq,mvp,d)$PQ)
+                     xvimvp := monomial(c,vimvp,d)$$
+                     newp := newp +$$ xvimvp
+                     pq := pq -$PQ monomial(coefficient(pq,mvp,d)$PQ,mvp,d)$PQ
+                   newp +$$ localRetractPQ(pq)
+
+             if R has Algebra Integer
+               then 
+                 localRetractPZ(pz:PZ):$ ==
+                   ground? pz => ((ground(pz)$PZ)::R)::$
+                   mvp : Symbol := (mainVariable(pz)$PZ)::Symbol
+                   d : NNI
+                   imvp : PositiveInteger := _
+                             (position(mvp,lv)$(List Symbol))::PositiveInteger 
+                   vimvp : V := index(imvp)$V
+                   xvimvp,c : $ 
+                   newp := 0$$
+                   while (not zero? (d := degree(pz,mvp))) repeat
+                     c := localRetractPZ(coefficient(pz,mvp,d)$PZ)
+                     xvimvp := monomial(c,vimvp,d)$$
+                     newp := newp +$$ xvimvp
+                     pz := pz -$PZ monomial(coefficient(pz,mvp,d)$PZ,mvp,d)$PZ
+                   newp +$$ localRetractPZ(pz)
+
+             retractable?(p:PR):Boolean ==
+               lvp := variables(p)$PR
+               while not empty? lvp and member?(first lvp,lv) repeat
+                 lvp := rest lvp
+               empty? lvp   
+                     
+             retractablePQ?(p:PQ):Boolean ==
+               lvp := variables(p)$PQ
+               while not empty? lvp and member?(first lvp,lv) repeat
+                 lvp := rest lvp
+               empty? lvp       
+                 
+             retractablePZ?(p:PZ):Boolean ==
+               lvp := variables(p)$PZ
+               while not empty? lvp and member?(first lvp,lv) repeat
+                 lvp := rest lvp
+               empty? lvp                        
+
+             localRetractIfCan(p : PR): Union($,"failed") ==
+               not retractable?(p) => "failed"::Union($,"failed")
+               localRetract(p)::Union($,"failed")
+
+             localRetractIfCanPQ(p : PQ): Union($,"failed") ==
+               not retractablePQ?(p) => "failed"::Union($,"failed")
+               localRetractPQ(p)::Union($,"failed")
+
+             localRetractIfCanPZ(p : PZ): Union($,"failed") ==
+               not retractablePZ?(p) => "failed"::Union($,"failed")
+               localRetractPZ(p)::Union($,"failed")
+
+         if R has Algebra Fraction Integer
+           then 
+
+             mpc2Z := MPolyCatFunctions2(Symbol,IES,IES,Z,R,PZ,PR)
+             mpc2Q := MPolyCatFunctions2(Symbol,IES,IES,Q,R,PQ,PR)
+             ZToR (z:Z):R == coerce(z)@R
+             QToR (q:Q):R == coerce(q)@R
+             PZToPR (pz:PZ):PR == map(ZToR,pz)$mpc2Z
+             PQToPR (pq:PQ):PR == map(QToR,pq)$mpc2Q
+
+             retract(pz:PZ) ==
+               rif : Union($,"failed") := retractIfCan(pz)@Union($,"failed")
+               (rif case "failed") => error _
+                                  "failed in retract: POLY Z -> $ from RPOLCAT"
+               rif::$
+
+             convert(pz:PZ) ==
+               retract(pz)@$
+
+             retract(pq:PQ) ==
+               rif : Union($,"failed") := retractIfCan(pq)@Union($,"failed")
+               (rif case "failed") => error _
+                                  "failed in retract: POLY Z -> $ from RPOLCAT"
+               rif::$
+
+             convert(pq:PQ) ==
+               retract(pq)@$
+
+             if not (R has QuotientFieldCategory(Integer))
+               then
+                 -- the only operation to implement is 
+                 -- retractIfCan : PR -> Union($,"failed")
+                 -- when V does not have Finite
+
+                 if V has Finite
+                   then
+                     retractIfCan(pr:PR) ==
+                       localRetractIfCan(pr)@Union($,"failed")
+
+                     retractIfCan(pq:PQ) ==
+                       localRetractIfCanPQ(pq)@Union($,"failed")
+                   else
+                     retractIfCan(pq:PQ) ==
+                       pr : PR := PQToPR(pq)
+                       retractIfCan(pr)@Union($,"failed")
+
+                 retractIfCan(pz:PZ) ==
+                   pr : PR := PZToPR(pz)
+                   retractIfCan(pr)@Union($,"failed")
+
+                 retract(pr:PR) ==
+                   rif : Union($,"failed") := _
+                                          retractIfCan(pr)@Union($,"failed")
+                   (rif case "failed") => error _
+                                "failed in retract: POLY Z -> $ from RPOLCAT"
+                   rif::$
+
+                 convert(pr:PR) ==
+                   retract(pr)@$
+
+               else
+                 -- the only operation to implement is 
+                 -- retractIfCan : PQ -> Union($,"failed")
+                 -- when V does not have Finite
+                 mpc2ZQ := MPolyCatFunctions2(Symbol,IES,IES,Z,Q,PZ,PQ)
+                 mpc2RQ := MPolyCatFunctions2(Symbol,IES,IES,R,Q,PR,PQ)
+                 ZToQ(z:Z):Q == coerce(z)@Q
+                 RToQ(r:R):Q == retract(r)@Q
+
+                 PZToPQ (pz:PZ):PQ == map(ZToQ,pz)$mpc2ZQ
+                 PRToPQ (pr:PR):PQ == map(RToQ,pr)$mpc2RQ
+
+                 retractIfCan(pz:PZ) ==
+                   pq : PQ := PZToPQ(pz)
+                   retractIfCan(pq)@Union($,"failed")
+
+                 if V has Finite
+                   then
+                     retractIfCan(pq:PQ) ==
+                       localRetractIfCanPQ(pq)@Union($,"failed")
+
+                     convert(pr:PR) ==
+                       lrif : Union($,"failed") := _
+                                       localRetractIfCan(pr)@Union($,"failed")
+                       (lrif case "failed") => error _
+                                       "failed in convert: PR->$ from RPOLCAT"
+                       lrif::$
+                   else
+                     convert(pr:PR) ==
+                       pq : PQ := PRToPQ(pr)
+                       retract(pq)@$
+
+         if (R has Algebra Integer) and not(R has Algebra Fraction Integer)
+           then 
+
+             mpc2Z := MPolyCatFunctions2(Symbol,IES,IES,Z,R,PZ,PR)
+             ZToR (z:Z):R == coerce(z)@R
+             PZToPR (pz:PZ):PR == map(ZToR,pz)$mpc2Z
+
+             retract(pz:PZ) ==
+               rif : Union($,"failed") := retractIfCan(pz)@Union($,"failed")
+               (rif case "failed") => error _
+                                 "failed in retract: POLY Z -> $ from RPOLCAT"
+               rif::$
+
+             convert(pz:PZ) ==
+               retract(pz)@$
+
+             if not (R has IntegerNumberSystem)
+               then
+                 -- the only operation to implement is 
+                 -- retractIfCan : PR -> Union($,"failed")
+                 -- when V does not have Finite
+
+                 if V has Finite
+                   then
+                     retractIfCan(pr:PR) ==
+                       localRetractIfCan(pr)@Union($,"failed")
+
+                     retractIfCan(pz:PZ) ==
+                       localRetractIfCanPZ(pz)@Union($,"failed")
+                   else
+                     retractIfCan(pz:PZ) ==
+                       pr : PR := PZToPR(pz)
+                       retractIfCan(pr)@Union($,"failed")
+
+                 retract(pr:PR) ==
+                   rif : Union($,"failed"):=retractIfCan(pr)@Union($,"failed")
+                   (rif case "failed") => error _
+                                  "failed in retract: POLY Z -> $ from RPOLCAT"
+                   rif::$
+
+                 convert(pr:PR) ==
+                   retract(pr)@$
 
-RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
- Category == 
-  PolynomialCategory(R, E, V) with
-     mvar : $ -> V
-         ++ \axiom{mvar(p)} returns an error if \axiom{p} belongs to 
-         ++ \axiom{R}, otherwise returns its main variable w. r. t. to the 
-         ++ total ordering on the elements in \axiom{V}.
-     mdeg  : $ -> NonNegativeInteger 
-         ++ \axiom{mdeg(p)} returns an error if \axiom{p} is \axiom{0}, 
-         ++ otherwise, if \axiom{p} belongs to \axiom{R} returns \axiom{0}, 
-         ++ otherwise, returns the degree of \axiom{p} in its main variable.
-     init : $ -> $
-         ++ \axiom{init(p)} returns an error if \axiom{p} belongs to 
-         ++ \axiom{R}, otherwise returns its leading coefficient, where 
-         ++ \axiom{p} is viewed as a univariate polynomial in its main 
-         ++ variable.
-     head  : $ -> $
-         ++ \axiom{head(p)} returns \axiom{p} if \axiom{p} belongs to 
-         ++ \axiom{R}, otherwise returns its leading term (monomial in the 
-         ++ AXIOM sense), where \axiom{p} is viewed as a univariate polynomial
-         ++  in its main variable.
-     tail  : $ -> $
-         ++ \axiom{tail(p)} returns its reductum, where \axiom{p} is viewed 
-         ++ as a univariate polynomial in its main variable.
-     deepestTail : $ -> $
-         ++ \axiom{deepestTail(p)} returns \axiom{0} if \axiom{p} belongs to 
-         ++ \axiom{R}, otherwise returns tail(p), if \axiom{tail(p)} belongs 
-         ++ to  \axiom{R} or \axiom{mvar(tail(p)) < mvar(p)}, otherwise 
-         ++ returns \axiom{deepestTail(tail(p))}.
-     iteratedInitials : $ -> List $ 
-         ++ \axiom{iteratedInitials(p)} returns \axiom{[]} if \axiom{p} 
-         ++ belongs to \axiom{R}, 
-         ++ otherwise returns the list of the iterated initials of \axiom{p}.
-     deepestInitial : $ -> $ 
-         ++ \axiom{deepestInitial(p)} returns an error if \axiom{p} belongs 
-         ++ to \axiom{R}, 
-         ++ otherwise returns the last term of \axiom{iteratedInitials(p)}.
-     leadingCoefficient : ($,V) -> $
-         ++ \axiom{leadingCoefficient(p,v)} returns the leading coefficient 
-         ++ of \axiom{p}, where \axiom{p} is viewed as A univariate 
-         ++ polynomial in \axiom{v}.
-     reductum  : ($,V) -> $
-         ++ \axiom{reductum(p,v)} returns the reductum of \axiom{p}, where 
-         ++ \axiom{p} is viewed as a univariate polynomial in \axiom{v}. 
-     monic? : $ -> Boolean
-         ++ \axiom{monic?(p)} returns false if \axiom{p} belongs to \axiom{R}, 
-         ++ otherwise returns true iff \axiom{p} is monic as a univariate 
-         ++ polynomial in its main variable.
-     quasiMonic? : $ -> Boolean
-         ++ \axiom{quasiMonic?(p)} returns false if \axiom{p} belongs to 
-         ++ \axiom{R}, otherwise returns true iff the initial of \axiom{p} 
-         ++ lies in the base ring \axiom{R}.
-     mainMonomial : $ -> $ 
-         ++ \axiom{mainMonomial(p)} returns an error if \axiom{p} is 
-         ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns 
-         ++ \axiom{1}, otherwise, \axiom{mvar(p)} raised to the power 
-         ++ \axiom{mdeg(p)}.
-     leastMonomial : $ -> $ 
-         ++ \axiom{leastMonomial(p)} returns an error if \axiom{p} is 
-         ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns 
-         ++ \axiom{1}, otherwise, the monomial of \axiom{p} with lowest 
-         ++ degree, where \axiom{p} is viewed as a univariate polynomial in 
-         ++ its main variable.
-     mainCoefficients : $ -> List $ 
-         ++ \axiom{mainCoefficients(p)} returns an error if \axiom{p} is 
-         ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns 
-         ++ [p], otherwise returns the list of the coefficients of \axiom{p}, 
-         ++ where \axiom{p} is viewed as a univariate polynomial in its main 
-         ++ variable.
-     mainMonomials : $ -> List $ 
-         ++ \axiom{mainMonomials(p)} returns an error if \axiom{p} is 
-         ++ \axiom{O}, otherwise, if \axiom{p} belongs to \axiom{R} returns 
-         ++ [1], otherwise returns the list of the monomials of \axiom{p}, 
-         ++ where \axiom{p} is viewed as a univariate polynomial in its main 
-         ++ variable.
-     RittWuCompare : ($, $) -> Union(Boolean,"failed")
-         ++ \axiom{RittWuCompare(a,b)} returns \axiom{"failed"} if \axiom{a} 
-         ++ and \axiom{b} have same rank w.r.t. 
-         ++ Ritt and Wu Wen Tsun ordering using the refinement of Lazard, 
-         ++ otherwise returns \axiom{infRittWu?(a,b)}.
-     infRittWu?  : ($, $) -> Boolean
-         ++ \axiom{infRittWu?(a,b)} returns true if \axiom{a} is less than 
-         ++ \axiom{b} w.r.t. the Ritt and Wu Wen Tsun ordering using the 
-         ++ refinement of Lazard.
-     supRittWu? : ($, $) -> Boolean
-         ++ \axiom{supRittWu?(a,b)} returns true if \axiom{a} is greater 
-         ++ than \axiom{b} w.r.t. the Ritt and Wu Wen Tsun ordering using the 
-         ++ refinement of Lazard.
-     reduced? : ($,$) -> Boolean
-         ++ \axiom{reduced?(a,b)} returns true iff 
-         ++ \axiom{degree(a,mvar(b)) < mdeg(b)}.
-     reduced? : ($,List($)) -> Boolean
-         ++ \axiom{reduced?(q,lp)} returns true iff \axiom{reduced?(q,p)} 
-         ++ holds for every \axiom{p} in \axiom{lp}.
-     headReduced? : ($,$) -> Boolean
-         ++ \axiom{headReduced?(a,b)} returns true iff 
-         ++ \axiom{degree(head(a),mvar(b)) < mdeg(b)}.
-     headReduced? : ($,List($)) -> Boolean
-         ++ \axiom{headReduced?(q,lp)} returns true iff 
-         ++ \axiom{headReduced?(q,p)} holds for every \axiom{p} in \axiom{lp}.
-     initiallyReduced? : ($,$) -> Boolean
-         ++ \axiom{initiallyReduced?(a,b)} returns false iff there exists an 
-         ++ iterated initial of \axiom{a} which is not reduced w.r.t \axiom{b}.
-     initiallyReduced? :  ($,List($)) -> Boolean
-         ++ \axiom{initiallyReduced?(q,lp)} returns true iff 
-         ++ \axiom{initiallyReduced?(q,p)} holds for every \axiom{p} in 
-         ++ \axiom{lp}.
-     normalized? : ($,$) -> Boolean
-         ++ \axiom{normalized?(a,b)} returns true iff \axiom{a} and its 
-         ++ iterated initials have degree zero w.r.t. the main variable of 
-         ++ \axiom{b}
-     normalized? : ($,List($)) -> Boolean
-         ++ \axiom{normalized?(q,lp)} returns true iff 
-         ++ \axiom{normalized?(q,p)} holds 
-         ++ for every \axiom{p} in \axiom{lp}.
-     prem : ($, $) -> $
-         ++ \axiom{prem(a,b)} computes the pseudo-remainder of \axiom{a} by 
-         ++ \axiom{b}, both viewed as univariate polynomials in the main 
-         ++ variable of \axiom{b}.
-     pquo : ($, $) -> $
-         ++ \axiom{pquo(a,b)} computes the pseudo-quotient of \axiom{a} by 
-         ++ \axiom{b}, both viewed as univariate polynomials in the main 
-         ++ variable of \axiom{b}.
-     prem : ($, $, V) -> $
-         ++ \axiom{prem(a,b,v)} computes the pseudo-remainder of \axiom{a} 
-         ++ by \axiom{b}, both viewed as univariate polynomials in \axiom{v}.
-     pquo : ($, $, V) -> $
-         ++ \axiom{pquo(a,b,v)} computes the pseudo-quotient of \axiom{a} by 
-         ++ \axiom{b}, both viewed as univariate polynomials in \axiom{v}.
-     lazyPrem : ($, $) ->  $
-         ++ \axiom{lazyPrem(a,b)} returns the polynomial \axiom{r} reduced 
-         ++ w.r.t. \axiom{b} and such that \axiom{b} divides 
-         ++ \axiom{init(b)^e a - r} where \axiom{e} 
-         ++ is the number of steps of this pseudo-division.
-     lazyPquo : ($, $) ->  $
-         ++ \axiom{lazyPquo(a,b)} returns the polynomial \axiom{q} such that 
-         ++ \axiom{lazyPseudoDivide(a,b)} returns \axiom{[c,g,q,r]}.
-     lazyPrem : ($, $, V) -> $
-         ++ \axiom{lazyPrem(a,b,v)} returns the polynomial \axiom{r} 
-         ++ reduced w.r.t. \axiom{b} viewed as univariate polynomials in the 
-         ++ variable \axiom{v} such that \axiom{b} divides 
-         ++ \axiom{init(b)^e a - r} where \axiom{e} is the number of steps of 
-         ++ this pseudo-division.
-     lazyPquo : ($, $, V) ->  $
-         ++ \axiom{lazyPquo(a,b,v)} returns the polynomial \axiom{q} such that 
-         ++ \axiom{lazyPseudoDivide(a,b,v)} returns \axiom{[c,g,q,r]}.
-     lazyPremWithDefault : ($, $) -> _
-       Record (coef : $, gap : NonNegativeInteger, remainder : $)
-         ++ \axiom{lazyPremWithDefault(a,b)} returns \axiom{[c,g,r]}
-         ++ such that \axiom{r = lazyPrem(a,b)} and 
-         ++ \axiom{(c**g)*r = prem(a,b)}.
-     lazyPremWithDefault : ($, $, V) -> _
-       Record (coef : $, gap : NonNegativeInteger, remainder : $)
-         ++ \axiom{lazyPremWithDefault(a,b,v)} returns \axiom{[c,g,r]} 
-         ++ such that \axiom{r = lazyPrem(a,b,v)} and 
-         ++ \axiom{(c**g)*r = prem(a,b,v)}.
-     lazyPseudoDivide : ($,$) -> _
-       Record(coef:$, gap: NonNegativeInteger,quotient:$, remainder:$)
-         ++ \axiom{lazyPseudoDivide(a,b)} returns \axiom{[c,g,q,r]} 
-         ++ such that \axiom{[c,g,r] = lazyPremWithDefault(a,b)} and
-         ++ \axiom{q} is the pseudo-quotient computed in this lazy 
-         ++ pseudo-division.
-     lazyPseudoDivide : ($,$,V) -> _
-       Record(coef:$, gap:NonNegativeInteger, quotient:$, remainder: $)
-         ++ \axiom{lazyPseudoDivide(a,b,v)} returns \axiom{[c,g,q,r]} such 
-         ++ that  \axiom{r = lazyPrem(a,b,v)}, \axiom{(c**g)*r = prem(a,b,v)} 
-         ++ and \axiom{q} is the pseudo-quotient computed in this lazy 
-         ++ pseudo-division.
-     pseudoDivide : ($, $) -> Record (quotient : $, remainder : $)
-         ++ \axiom{pseudoDivide(a,b)} computes \axiom{[pquo(a,b),prem(a,b)]}, 
-         ++ both polynomials viewed as univariate polynomials in the main 
-         ++ variable of \axiom{b}, if \axiom{b} is not a constant polynomial.
-     monicModulo : ($, $) -> $ 
-         ++ \axiom{monicModulo(a,b)} computes \axiom{a mod b}, if \axiom{b} is 
-         ++ monic as univariate polynomial in its main variable.
-     lazyResidueClass : ($,$) -> _
-      Record(polnum:$, polden:$, power:NonNegativeInteger)
-         ++ \axiom{lazyResidueClass(a,b)} returns \axiom{[p,q,n]} where 
-         ++ \axiom{p / q**n} represents the residue class of \axiom{a} 
-         ++ modulo \axiom{b} and \axiom{p} is reduced w.r.t. \axiom{b} and 
-         ++ \axiom{q} is \axiom{init(b)}.
-     headReduce: ($, $) ->  $
-         ++ \axiom{headReduce(a,b)} returns a polynomial \axiom{r} such that 
-         ++ \axiom{headReduced?(r,b)} holds and there exists an integer 
-         ++ \axiom{e} such that \axiom{init(b)^e a - r} is zero modulo 
-         ++ \axiom{b}.
-     initiallyReduce: ($, $) ->  $
-         ++ \axiom{initiallyReduce(a,b)} returns a polynomial \axiom{r} such 
-         ++ that \axiom{initiallyReduced?(r,b)} holds and there exists an 
-         ++ integer \axiom{e} such that \axiom{init(b)^e a - r} is zero 
-         ++ modulo \axiom{b}.
+               else
+                 -- the only operation to implement is 
+                 -- retractIfCan : PZ -> Union($,"failed")
+                 -- when V does not have Finite
 
-     if (V has ConvertibleTo(Symbol))
-     then 
-       CoercibleTo(Polynomial R)
-       ConvertibleTo(Polynomial R)
-       if R has Algebra Fraction Integer
-         then 
-           retractIfCan : Polynomial Fraction Integer -> Union($,"failed")
-               ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of 
-               ++ the current domain if all its variables belong to \axiom{V}.
-           retract : Polynomial Fraction Integer -> $
-               ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
-               ++ current domain if \axiom{retractIfCan(p)} does not return 
-               ++ "failed", otherwise an error is produced.
-           convert : Polynomial Fraction Integer -> $
-               ++ \axiom{convert(p)} returns the same as \axiom{retract(p)}.
-           retractIfCan : Polynomial Integer -> Union($,"failed")
-               ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of 
-               ++ the current domain if all its variables belong to \axiom{V}.
-           retract : Polynomial Integer -> $
-               ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
-               ++ current domain if \axiom{retractIfCan(p)} does not return 
-               ++ "failed", otherwise an error is produced.
-           convert : Polynomial Integer -> $
-               ++ \axiom{convert(p)} returns the same as \axiom{retract(p)}
-           if not (R has QuotientFieldCategory(Integer))
-             then
-               retractIfCan : Polynomial R -> Union($,"failed")
-                 ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element 
-                 ++ of the current domain if all its variables belong to 
-                 ++ \axiom{V}.
-               retract : Polynomial R -> $
-                 ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
-                 ++ current domain if \axiom{retractIfCan(p)} does not 
-                 ++ return "failed", otherwise an error is produced.
-       if (R has Algebra Integer) and not(R has Algebra Fraction Integer)
-         then 
-           retractIfCan : Polynomial Integer -> Union($,"failed")
-               ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of 
-               ++ the current domain if all its variables belong to \axiom{V}.
-           retract : Polynomial Integer -> $
-               ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
-               ++ current domain if \axiom{retractIfCan(p)} does not return 
-               ++ "failed", otherwise an error is produced.
-           convert : Polynomial Integer -> $
-               ++ \axiom{convert(p)} returns the same as \axiom{retract(p)}.
-           if not (R has IntegerNumberSystem)
-             then
-               retractIfCan : Polynomial R -> Union($,"failed")
-                 ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element 
-                 ++ of the current domain if all its variables belong to 
-                 ++ \axiom{V}.
-               retract : Polynomial R -> $
-                 ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
-                 ++ current domain if \axiom{retractIfCan(p)} does not 
-                 ++ return "failed", otherwise an error is produced.
-       if not(R has Algebra Integer) and not(R has Algebra Fraction Integer)
-         then 
-           retractIfCan : Polynomial R -> Union($,"failed")
-             ++ \axiom{retractIfCan(p)} returns \axiom{p} as an element of 
-             ++ the current domain if all its variables belong to \axiom{V}.
-           retract : Polynomial R -> $
-             ++ \axiom{retract(p)} returns \axiom{p} as an element of the 
-             ++ current domain if \axiom{retractIfCan(p)} does not return 
-             ++ "failed", otherwise an error is produced.
-       convert : Polynomial R -> $
-         ++ \axiom{convert(p)} returns \axiom{p} as an element of the current 
-         ++ domain if all its variables belong to \axiom{V}, otherwise an 
-         ++ error is produced.
+                 mpc2RZ := MPolyCatFunctions2(Symbol,IES,IES,R,Z,PR,PZ)
+                 RToZ(r:R):Z == retract(r)@Z
+                 PRToPZ (pr:PR):PZ == map(RToZ,pr)$mpc2RZ
 
-       if R has RetractableTo(Integer)
-       then
-         ConvertibleTo(String)
+                 if V has Finite
+                   then
+                     convert(pr:PR) ==
+                       lrif : Union($,"failed") := _
+                                       localRetractIfCan(pr)@Union($,"failed")
+                       (lrif case "failed") => error _
+                                       "failed in convert: PR->$ from RPOLCAT"
+                       lrif::$
+                     retractIfCan(pz:PZ) ==
+                       localRetractIfCanPZ(pz)@Union($,"failed")
+                   else
+                     convert(pr:PR) ==
+                       pz : PZ := PRToPZ(pr)
+                       retract(pz)@$
 
-     if R has IntegralDomain
-     then
-       primPartElseUnitCanonical : $ -> $
-           ++ \axiom{primPartElseUnitCanonical(p)} returns 
-           ++ \axiom{primitivePart(p)} if \axiom{R} is a gcd-domain, 
-           ++ otherwise \axiom{unitCanonical(p)}.
-       primPartElseUnitCanonical! : $ -> $
-           ++ \axiom{primPartElseUnitCanonical!(p)} replaces  \axiom{p} 
-           ++ by \axiom{primPartElseUnitCanonical(p)}.
-       exactQuotient : ($,R) -> $
-           ++ \axiom{exactQuotient(p,r)} computes the exact quotient of 
-           ++ \axiom{p} by \axiom{r}, which is assumed to be a divisor of 
-           ++ \axiom{p}. No error is returned if this exact quotient fails!
-       exactQuotient! : ($,R) -> $
-           ++ \axiom{exactQuotient!(p,r)} replaces \axiom{p} by 
-           ++ \axiom{exactQuotient(p,r)}.
-       exactQuotient : ($,$) -> $
-           ++ \axiom{exactQuotient(a,b)} computes the exact quotient of 
-           ++ \axiom{a} by \axiom{b}, which is assumed to be a divisor of 
-           ++ \axiom{a}. No error is returned if this exact quotient fails!
-       exactQuotient! : ($,$) -> $
-           ++ \axiom{exactQuotient!(a,b)} replaces \axiom{a} by 
-           ++ \axiom{exactQuotient(a,b)}
-       subResultantGcd : ($, $) -> $ 
-           ++ \axiom{subResultantGcd(a,b)} computes a gcd of \axiom{a} and 
-           ++ \axiom{b} where \axiom{a} and \axiom{b} are assumed to have the 
-           ++ same main variable \axiom{v} and are viewed as univariate 
-           ++ polynomials in \axiom{v} with coefficients in the fraction 
-           ++ field of the polynomial ring generated by their other variables 
-           ++ over \axiom{R}.
-       extendedSubResultantGcd : ($, $) -> _
-        Record (gcd : $, coef1 : $, coef2 : $)
-           ++ \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[ca,cb,r]} 
-           ++ such that \axiom{r} is \axiom{subResultantGcd(a,b)} and we have
-           ++ \axiom{ca * a + cb * cb = r} .
-       halfExtendedSubResultantGcd1: ($, $) -> Record (gcd : $, coef1 : $)
-           ++ \axiom{halfExtendedSubResultantGcd1(a,b)} returns \axiom{[g,ca]}
-           ++ if \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[g,ca,cb]}
-           ++ otherwise produces an error.
-       halfExtendedSubResultantGcd2: ($, $) -> Record (gcd : $, coef2 : $)
-           ++ \axiom{halfExtendedSubResultantGcd2(a,b)} returns \axiom{[g,cb]}
-           ++ if \axiom{extendedSubResultantGcd(a,b)} returns \axiom{[g,ca,cb]}
-           ++ otherwise produces an error.
-       resultant  : ($, $) -> $ 
-           ++ \axiom{resultant(a,b)} computes the resultant of \axiom{a} and 
-           ++ \axiom{b} where \axiom{a} and \axiom{b} are assumed to have the 
-           ++ same main variable \axiom{v} and are viewed as univariate 
-           ++ polynomials in \axiom{v}.
-       subResultantChain : ($, $) -> List $
-           ++ \axiom{subResultantChain(a,b)}, where \axiom{a} and \axiom{b} 
-           ++ are not contant polynomials with the same main variable, returns
-           ++ the subresultant chain of \axiom{a} and \axiom{b}.
-       lastSubResultant: ($, $) -> $
-           ++ \axiom{lastSubResultant(a,b)} returns the last non-zero 
-           ++ subresultant of \axiom{a} and \axiom{b} where \axiom{a} and 
-           ++ \axiom{b} are assumed to have the same main variable \axiom{v} 
-           ++ and are viewed as univariate polynomials in \axiom{v}.
-       LazardQuotient: ($, $, NonNegativeInteger) -> $
-           ++ \axiom{LazardQuotient(a,b,n)} returns \axiom{a**n exquo b**(n-1)}
-           ++ assuming that this quotient does not fail.
-       LazardQuotient2: ($, $, $, NonNegativeInteger) -> $
-           ++ \axiom{LazardQuotient2(p,a,b,n)} returns 
-           ++ \axiom{(a**(n-1) * p) exquo b**(n-1)}
-           ++ assuming that this quotient does not fail.
-       next_subResultant2: ($, $, $, $) -> $
-           ++ \axiom{nextsubResultant2(p,q,z,s)} is the multivariate version
-           ++ of the operation 
-           ++ next_sousResultant2 from PseudoRemainderSequence from
-           ++ the \axiomType{PseudoRemainderSequence} constructor.
 
-     if R has GcdDomain
-     then
-       gcd : (R,$) -> R
-           ++ \axiom{gcd(r,p)} returns the gcd of \axiom{r} and the content 
-           ++ of \axiom{p}.
-       primitivePart! : $ -> $
-           ++ \axiom{primitivePart!(p)} replaces \axiom{p}  by its primitive 
-           ++ part.
-       mainContent : $ -> $
-           ++ \axiom{mainContent(p)} returns the content of \axiom{p} viewed 
-           ++ as a univariate polynomial in its main variable and with 
-           ++ coefficients in the polynomial ring generated by its other 
-           ++ variables over \axiom{R}.
-       mainPrimitivePart : $ -> $
-           ++ \axiom{mainPrimitivePart(p)} returns the primitive part of 
-           ++ \axiom{p} viewed as a univariate polynomial in its main 
-           ++ variable and with coefficients in the polynomial ring generated 
-           ++ by its other variables over \axiom{R}.
-       mainSquareFreePart : $ -> $
-           ++ \axiom{mainSquareFreePart(p)} returns the square free part of 
-           ++ \axiom{p} viewed as a univariate polynomial in its main 
-           ++ variable and with coefficients in the polynomial ring 
-           ++ generated by its other variables over \axiom{R}.
+         if not(R has Algebra Integer) and not(R has Algebra Fraction Integer)
+           then 
+             -- the only operation to implement is 
+             -- retractIfCan : PR -> Union($,"failed")
 
- add
+             if V has Finite
+               then
+                 retractIfCan(pr:PR) ==
+                   localRetractIfCan(pr)@Union($,"failed")
+
+             retract(pr:PR) ==
+               rif : Union($,"failed") := retractIfCan(pr)@Union($,"failed")
+               (rif case "failed") => error _
+                               "failed in retract: POLY Z -> $ from RPOLCAT"
+               rif::$
+
+             convert(pr:PR) ==
+               retract(pr)@$
+
+         if (R has RetractableTo(INT))
+           then
+
+             convert(pol:$):String ==
+               ground?(pol) => convert(retract(ground(pol))@INT)@String
+               ipol : $ := init(pol)
+               vpol : V := mvar(pol)
+               dpol : NNI := mdeg(pol)
+               tpol: $  := tail(pol)
+               sipol,svpol,sdpol,stpol : String
+               if (ipol = 1)
+                 then 
+                   sipol := empty()$String
+                 else
+                   if ((-ipol) = 1)
+                     then 
+                       sipol := "-"
+                     else
+                       sipol := convert(ipol)@String
+                       if not monomial?(ipol)
+                         then
+                           sipol := concat(["(",sipol,")*"])$String
+                         else 
+                           sipol := concat(sipol,"*")$String
+               svpol := string(convert(vpol)@Symbol)
+               if (dpol = 1)
+                 then
+                   sdpol :=  empty()$String
+                 else
+                   sdpol := _
+                        concat("**",convert(convert(dpol)@INT)@String )$String 
+               if zero? tpol
+                 then
+                   stpol :=  empty()$String
+                 else
+                   if ground?(tpol)
+                     then
+                       n := retract(ground(tpol))@INT
+                       if n > 0
+                         then
+                           stpol :=  concat(" +",convert(n)@String)$String
+                         else
+                           stpol := convert(n)@String
+                     else
+                       stpol := convert(tpol)@String
+                       if _
+                         not member?((stpol.1)::String,["+","-"])$(List String)
+                         then
+                           stpol :=  concat(" + ",stpol)$String
+               concat([sipol,svpol,sdpol,stpol])$String
+
+\end{chunk}
+
+\begin{chunk}{COQ RPOLCAT}
+(* category RPOLCAT *)
+(*
      O ==> OutputForm
      NNI ==> NonNegativeInteger
      INT ==> Integer
 
-     exactQuo : (R,R) -> R
-
+     coerce : % -> OutputForm
      coerce(p:$):O ==
        ground? (p) => (ground(p))::O
---       if one?((ip := init(p)))
        if (((ip := init(p))) = 1)
          then
            if zero?((tp := tail(p)))
              then
---               if one?((dp := mdeg(p)))
                if (((dp := mdeg(p))) = 1)
                  then
                    return((mvar(p))::O)
                  else
                    return(((mvar(p))::O **$O (dp::O)))
              else
---               if one?((dp := mdeg(p)))
                if (((dp := mdeg(p))) = 1)
                  then
                    return((mvar(p))::O +$O (tp::O))
@@ -66728,96 +77310,111 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
           else
            if zero?((tp := tail(p)))
              then
---               if one?((dp := mdeg(p)))
                if (((dp := mdeg(p))) = 1)
                  then
                    return((ip::O) *$O  (mvar(p))::O)
                  else
                    return((ip::O) *$O ((mvar(p))::O **$O (dp::O)))
              else
---               if one?(mdeg(p))
                if ((mdeg(p)) = 1)
                  then
                    return(((ip::O) *$O  (mvar(p))::O) +$O (tp::O))
        ((ip)::O *$O ((mvar(p))::O **$O ((mdeg(p)::O))) +$O (tail(p)::O))
 
+     mvar : % -> V
      mvar p ==
        ground?(p) => error"Error in mvar from RPOLCAT : #1 is constant."
        mainVariable(p)::V
 
+     mdeg : % -> NonNegativeInteger
      mdeg p == 
        ground?(p) => 0$NNI
        degree(p,mainVariable(p)::V)
 
+     init : % -> %
      init p ==
        ground?(p) => error"Error in mvar from RPOLCAT : #1 is constant."
        v := mainVariable(p)::V
        coefficient(p,v,degree(p,v))
 
+     leadingCoefficient : (%,V) -> %
      leadingCoefficient (p,v) ==
        zero? (d := degree(p,v)) => p
        coefficient(p,v,d)
 
+     head : % -> %
      head p ==
        ground? p => p
        v := mainVariable(p)::V
        d := degree(p,v)
        monomial(coefficient(p,v,d),v,d)
 
+     reductum : (%,V) -> %
      reductum(p,v) ==
        zero? (d := degree(p,v)) => 0$$
        p - monomial(coefficient(p,v,d),v,d)
 
+     tail : % -> %
      tail p ==
        ground? p => 0$$
        p - head(p)
 
+     deepestTail : % -> %
      deepestTail p ==
        ground? p => 0$$
        ground? tail(p) => tail(p)
        mvar(p) > mvar(tail(p)) => tail(p)
        deepestTail(tail(p))
 
+     iteratedInitials : % -> List(%)
      iteratedInitials p == 
        ground? p => []
        p := init(p)
        cons(p,iteratedInitials(p))
 
+     localDeepestInitial : $ -> $
      localDeepestInitial (p : $) : $ == 
        ground? p => p
        localDeepestInitial init p
 
+     deepestInitial : % -> %
      deepestInitial p == 
        ground? p => _
          error"Error in deepestInitial from RPOLCAT : #1 is constant."
        localDeepestInitial init p
 
+     monic? : % -> Boolean
      monic? p ==
        ground? p => false
        (recip(init(p))$$ case $)@Boolean
 
+     quasiMonic? : % -> Boolean
      quasiMonic?  p ==
        ground? p => false
        ground?(init(p))
 
+     mainMonomial : % -> %
      mainMonomial p == 
        zero? p => error"Error in mainMonomial from RPOLCAT : #1 is zero"
        ground? p => 1$$
        v := mainVariable(p)::V
        monomial(1$$,v,degree(p,v))
 
+     leastMonomial : % -> %
      leastMonomial p == 
        zero? p => error"Error in leastMonomial from RPOLCAT : #1 is zero"
        ground? p => 1$$
        v := mainVariable(p)::V
        monomial(1$$,v,minimumDegree(p,v))
 
+     mainCoefficients : % -> List(%)
      mainCoefficients p == 
        zero? p => error"Error in mainCoefficients from RPOLCAT : #1 is zero"
        ground? p => [p]
        v := mainVariable(p)::V
        coefficients(univariate(p,v)@SparseUnivariatePolynomial($))
 
+     mainMonomials : % -> List(%)
      mainMonomials p == 
        zero? p => error"Error in mainMonomials from RPOLCAT : #1 is zero"
        ground? p => [1$$]
@@ -66825,6 +77422,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
        lm := monomials(univariate(p,v)@SparseUnivariatePolynomial($))
        [monomial(1$$,v,degree(m)) for m in lm]
 
+     RittWuCompare : (%,%) -> Union(Boolean,"failed")
      RittWuCompare (a,b) ==
        (ground? b and  ground? a) => "failed"::Union(Boolean,"failed")
        ground? b => false::Union(Boolean,"failed")
@@ -66837,39 +77435,48 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
        lc case Boolean => lc
        RittWuCompare(tail(a),tail(b))
 
+     infRittWu? : (%,%) -> Boolean
      infRittWu? (a,b) ==
        lc : Union(Boolean,"failed") := RittWuCompare(a,b)
        lc case Boolean => lc::Boolean
        false
        
+     supRittWu? : (%,%) -> Boolean
      supRittWu? (a,b) ==
        infRittWu? (b,a)
 
+     prem : (%,%) -> %
      prem (a:$, b:$)  : $ == 
        cP := lazyPremWithDefault (a,b)
        ((cP.coef) ** (cP.gap)) * cP.remainder
 
+     pquo : (%,%) -> %
      pquo (a:$, b:$)  : $ == 
        cPS := lazyPseudoDivide (a,b)
        c := (cPS.coef) ** (cPS.gap)
        c * cPS.quotient
 
+     prem : (%,%,V) -> %
      prem (a:$, b:$, v:V) : $ ==
        cP := lazyPremWithDefault (a,b,v)
        ((cP.coef) ** (cP.gap)) * cP.remainder  
 
+     pquo : (%,%,V) -> %
      pquo (a:$, b:$, v:V)  : $ == 
        cPS := lazyPseudoDivide (a,b,v)
        c := (cPS.coef) ** (cPS.gap)
        c * cPS.quotient     
 
+     lazyPrem : (%,%) -> %
      lazyPrem (a:$, b:$) : $ ==
        (not ground?(b)) and (monic?(b)) => monicModulo(a,b)
        (lazyPremWithDefault (a,b)).remainder
        
+     lazyPquo : (%,%) -> %
      lazyPquo (a:$, b:$) : $ ==
        (lazyPseudoDivide (a,b)).quotient
 
+     lazyPrem : (%,%,V) -> %
      lazyPrem (a:$, b:$, v:V) : $ ==
        zero? b => _
          error"Error in lazyPrem : ($,$,V) -> $ from RPOLCAT : #2 is zero"
@@ -66888,9 +77495,11 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
          test := degree(a,v)::INT - dbv 
        a
          
+     lazyPquo : (%,%,V) -> %
      lazyPquo (a:$, b:$, v:V) : $ ==
        (lazyPseudoDivide (a,b,v)).quotient
 
+     headReduce : (%,%) -> %
      headReduce (a:$,b:$) == 
        ground? b => error _
         "Error in headReduce : ($,$) -> Boolean from TSETCAT : #2 is constant"
@@ -66905,6 +77514,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
              a := lrc.polnum +  (lrc.polden)**(lrc.power) * tail(a)
        a
 
+     initiallyReduce : (%,%) -> %
      initiallyReduce(a:$,b:$) ==
        ground? b => error _
    "Error in initiallyReduce : ($,$) -> Boolean from TSETCAT : #2 is constant"
@@ -66935,6 +77545,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
                  ia := init(ia)
        ia * ma + ta
 
+     lazyPremWithDefault : (%,%) ->
+        Record(coef: %,gap: NonNegativeInteger,remainder: %)
      lazyPremWithDefault (a,b) == 
        ground?(b) => error _
          "Error in lazyPremWithDefault from RPOLCAT : #2 is constant"
@@ -66962,7 +77574,9 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
              test := degree(a,xb)::INT - db
        [lcb, (delta::NNI), a]
 
-     lazyPremWithDefault (a,b,v) == 
+    lazyPremWithDefault : (%,%,V) ->
+       Record(coef: %,gap: NonNegativeInteger,remainder: %)
+    lazyPremWithDefault (a,b,v) == 
        zero? b =>  error _
         "Error in lazyPremWithDefault : ($,$,V) -> $ from RPOLCAT : #2 is zero"
        ground?(b) => [b,1$NNI,0$$]
@@ -66982,11 +77596,14 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
          test := degree(a,v)::INT - dbv 
        [lcbv, (delta::NNI), a]
 
+     pseudoDivide : (%,%) -> Record(quotient: %,remainder: %)
      pseudoDivide (a,b) == 
        cPS := lazyPseudoDivide (a,b)
        c := (cPS.coef) ** (cPS.gap)
        [c * cPS.quotient, c * cPS.remainder]
 
+     lazyPseudoDivide : (%,%) -> 
+        Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %)
      lazyPseudoDivide (a,b) == 
        ground?(b) => error _
           "Error in lazyPseudoDivide from RPOLCAT : #2 is constant"
@@ -67017,6 +77634,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
              test := degree(a,xb)::INT - db
        [lcb, (delta::NNI), q, a]
 
+     lazyPseudoDivide : (%,%,V) ->
+        Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %)
      lazyPseudoDivide (a,b,v) == 
        zero? b =>  error _
          "Error in lazyPseudoDivide : ($,$,V) -> $ from RPOLCAT : #2 is zero"
@@ -67039,6 +77658,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
          test := degree(a,v)::INT - dbv 
        [lcbv, (delta::NNI), q, a]
 
+     monicModulo : (%,%) -> %
      monicModulo (a,b) == 
        ground?(b) => error"Error in monicModulo from RPOLCAT : #2 is constant"
        rec : Union($,"failed") 
@@ -67048,6 +77668,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
        ground? a => a
        ib * ((lazyPremWithDefault ((rec::$) * a,(rec::$) * b)).remainder)
 
+     lazyResidueClass : (%,%) ->
+         Record(polnum: %,polden: %,power: NonNegativeInteger)
      lazyResidueClass(a,b) ==
        zero? b => [a,1$$,0$NNI]
        ground? b => [0$$,1$$,0$NNI]
@@ -67076,21 +77698,26 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
              test := degree(a,xb)::INT - db
        [a,lcb,pow]
 
+     reduced? : (%,%) -> Boolean
      reduced? (a:$,b:$) : Boolean ==
        degree(a,mvar(b)) < mdeg(b)
 
+     reduced? : (%,List(%)) -> Boolean
      reduced? (p:$, lq : List($)) : Boolean ==
        ground? p => true
        while (not empty? lq) and (reduced?(p, first lq)) repeat
          lq := rest lq
        empty? lq
 
+     headReduced? : (%,%) -> Boolean
      headReduced? (a:$,b:$) : Boolean ==
        reduced?(head(a),b)
 
+     headReduced? : (%,List(%)) -> Boolean
      headReduced? (p:$, lq : List($)) : Boolean ==
        reduced?(head(p),lq)
 
+     initiallyReduced? : (%,%) -> Boolean
      initiallyReduced? (a:$,b:$) : Boolean ==
        ground? b => error _
    "Error in initiallyReduced? : ($,$) -> Bool. from RPOLCAT : #2 is constant"
@@ -67099,12 +77726,14 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
        (mvar(a) = mvar(b)) => reduced?(a,b)
        initiallyReduced?(init(a),b)
 
+     initiallyReduced? : (%,List(%)) -> Boolean
      initiallyReduced? (p:$, lq : List($)) : Boolean ==
        ground? p => true
        while (not empty? lq) and (initiallyReduced?(p, first lq)) repeat
          lq := rest lq
        empty? lq
 
+     normalized? : (%,%) -> Boolean
      normalized?(a:$,b:$) : Boolean ==
        ground? b => error _
       "Error in  normalized? : ($,$) -> Boolean from TSETCAT : #2 is constant"
@@ -67113,6 +77742,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
        (mvar(a) = mvar(b)) => false
        normalized?(init(a),b)
 
+     normalized? : (%,List(%)) -> Boolean
      normalized? (p:$, lq : List($)) : Boolean ==
        while (not empty? lq) and (normalized?(p, first lq)) repeat
          lq := rest lq
@@ -67123,19 +77753,27 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
 
        if R has EuclideanDomain
          then
+
+           exactQuo : (R,R) -> R
            exactQuo(r:R,s:R):R ==
              r quo$R s
+
          else
+
+           exactQuo : (R,R) -> R
            exactQuo(r:R,s:R):R ==
              (r exquo$R s)::R
 
+       exactQuotient : (%,R) -> %
        exactQuotient (p:$,r:R) ==
          (p exquo$$ r)::$
 
+       exactQuotient : (%,%) -> %
        exactQuotient (a:$,b:$) ==
          ground? b => exactQuotient(a,ground(b))
          (a exquo$$ b)::$
 
+       exactQuotient! : (%,%) -> %
        exactQuotient! (a:$,b:$) ==
          ground? b => exactQuotient!(a,ground(b))
          a := (a exquo$$ b)::$
@@ -67143,12 +77781,13 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
        if (R has GcdDomain) and not(R has Field)
        then
 
+         primPartElseUnitCanonical : % -> %
          primPartElseUnitCanonical p ==
            primitivePart p
 
+         primitivePart! : % -> %
          primitivePart! p ==
            zero? p => p
---           if one?(cp := content(p))
            if ((cp := content(p)) = 1)
              then
                p := unitCanonical p
@@ -67156,13 +77795,17 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
                p := unitCanonical exactQuotient!(p,cp) 
            p
 
+         primPartElseUnitCanonical! : % -> % if R has INTDOM
          primPartElseUnitCanonical! p ==
            primitivePart! p
 
        else
+
+         primPartElseUnitCanonical : % -> %
          primPartElseUnitCanonical p ==
            unitCanonical p
 
+         primPartElseUnitCanonical! : % -> % if R has INTDOM
          primPartElseUnitCanonical! p ==
            p := unitCanonical p
 
@@ -67170,21 +77813,24 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
      if R has GcdDomain
      then
 
+       gcd : (%,%) -> %
        gcd(r:R,p:$):R ==
---         one? r => r
          (r = 1) => r
          zero? p => r
          ground? p => gcd(r,ground(p))$R
          gcd(gcd(r,init(p)),tail(p))
 
+       mainContent : % -> %
        mainContent p ==
          zero? p => p
          "gcd"/mainCoefficients(p)
 
+       mainPrimitivePart : % -> %
        mainPrimitivePart p ==
          zero? p => p
          (unitNormal((p exquo$$ mainContent(p))::$)).canonical
 
+       mainSquareFreePart : % -> %
        mainSquareFreePart p ==
          ground? p => p
          v := mainVariable(p)::V
@@ -67202,6 +77848,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
          Q ==> Fraction Integer
          Z ==> Integer
 
+         convert : % -> Polynomial(R)
          convert(p:$) : PR ==
            ground? p => (ground(p)$$)::PR
            v : V := mvar(p)
@@ -67209,24 +77856,20 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
            convert(init(p))@PR *$PR _
                         ((convert(v)@Symbol)::PR)**d +$PR convert(tail(p))@PR
 
+         coerce : % -> Polynomial(R)
          coerce(p:$) : PR ==
            convert(p)@PR
 
-         localRetract : PR -> $
-         localRetractPQ : PQ -> $
-         localRetractPZ : PZ -> $
-         localRetractIfCan : PR -> Union($,"failed")
-         localRetractIfCanPQ : PQ -> Union($,"failed")
-         localRetractIfCanPZ : PZ -> Union($,"failed")
-
          if V has Finite
            then 
 
              sizeV : NNI := size()$V
+
              lv : List Symbol
              lv := _
                [convert(index(i::PositiveInteger)$V)@Symbol for i in 1..sizeV]
 
+             localRetract : PR -> $
              localRetract(p : PR) : $ ==
                ground? p => (ground(p)$PR)::$
                mvp : Symbol := (mainVariable(p)$PR)::Symbol
@@ -67245,6 +77888,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
 
              if R has Algebra Fraction Integer
                then 
+
+                 localRetractPQ : PQ -> $                 
                  localRetractPQ(pq:PQ):$ ==
                    ground? pq => ((ground(pq)$PQ)::R)::$
                    mvp : Symbol := (mainVariable(pq)$PQ)::Symbol
@@ -67263,6 +77908,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
 
              if R has Algebra Integer
                then 
+
+                 localRetractPZ : PZ -> $
                  localRetractPZ(pz:PZ):$ ==
                    ground? pz => ((ground(pz)$PZ)::R)::$
                    mvp : Symbol := (mainVariable(pz)$PZ)::Symbol
@@ -67279,32 +77926,38 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
                      pz := pz -$PZ monomial(coefficient(pz,mvp,d)$PZ,mvp,d)$PZ
                    newp +$$ localRetractPZ(pz)
 
+             retractable? : PR -> Boolean
              retractable?(p:PR):Boolean ==
                lvp := variables(p)$PR
                while not empty? lvp and member?(first lvp,lv) repeat
                  lvp := rest lvp
                empty? lvp   
                      
+             retractablePQ? : PQ -> Boolean
              retractablePQ?(p:PQ):Boolean ==
                lvp := variables(p)$PQ
                while not empty? lvp and member?(first lvp,lv) repeat
                  lvp := rest lvp
                empty? lvp       
                  
+             retractablePZ? : PZ -> Boolean
              retractablePZ?(p:PZ):Boolean ==
                lvp := variables(p)$PZ
                while not empty? lvp and member?(first lvp,lv) repeat
                  lvp := rest lvp
                empty? lvp                        
 
+             localRetractIfCan : PR -> Union($,"failed")
              localRetractIfCan(p : PR): Union($,"failed") ==
                not retractable?(p) => "failed"::Union($,"failed")
                localRetract(p)::Union($,"failed")
 
+             localRetractIfCanPQ : PQ -> Union($,"failed")
              localRetractIfCanPQ(p : PQ): Union($,"failed") ==
                not retractablePQ?(p) => "failed"::Union($,"failed")
                localRetractPQ(p)::Union($,"failed")
 
+             localRetractIfCanPZ : PZ -> Union($,"failed")
              localRetractIfCanPZ(p : PZ): Union($,"failed") ==
                not retractablePZ?(p) => "failed"::Union($,"failed")
                localRetractPZ(p)::Union($,"failed")
@@ -67314,26 +77967,38 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
 
              mpc2Z := MPolyCatFunctions2(Symbol,IES,IES,Z,R,PZ,PR)
              mpc2Q := MPolyCatFunctions2(Symbol,IES,IES,Q,R,PQ,PR)
+
+             ZToR : Z -> R
              ZToR (z:Z):R == coerce(z)@R
+
+             QToR : Q -> R
              QToR (q:Q):R == coerce(q)@R
+
+             PZToPR : PZ -> PR
              PZToPR (pz:PZ):PR == map(ZToR,pz)$mpc2Z
+
+             PQToPR : PQ -> PR
              PQToPR (pq:PQ):PR == map(QToR,pq)$mpc2Q
 
+             retract : Polynomial(Integer) -> %
              retract(pz:PZ) ==
                rif : Union($,"failed") := retractIfCan(pz)@Union($,"failed")
                (rif case "failed") => error _
                                   "failed in retract: POLY Z -> $ from RPOLCAT"
                rif::$
 
+             convert : Polynomial(Integer) -> %
              convert(pz:PZ) ==
                retract(pz)@$
 
+             retract : Polynomial(Fraction(Integer)) -> %
              retract(pq:PQ) ==
                rif : Union($,"failed") := retractIfCan(pq)@Union($,"failed")
                (rif case "failed") => error _
                                   "failed in retract: POLY Z -> $ from RPOLCAT"
                rif::$
 
+             convert : Polynomial(Fraction(Integer)) -> %
              convert(pq:PQ) ==
                retract(pq)@$
 
@@ -67345,20 +78010,29 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
 
                  if V has Finite
                    then
+
+                     retractIfCan : Polynomial(R) -> Union(%,"failed")
                      retractIfCan(pr:PR) ==
                        localRetractIfCan(pr)@Union($,"failed")
 
+                     retractIfCan : Polynomial(Fraction(Integer)) ->
+                         Union(%,"failed")
                      retractIfCan(pq:PQ) ==
                        localRetractIfCanPQ(pq)@Union($,"failed")
                    else
+
+                     retractIfCan : Polynomial(Fraction(Integer)) ->
+                         Union(%,"failed")
                      retractIfCan(pq:PQ) ==
                        pr : PR := PQToPR(pq)
                        retractIfCan(pr)@Union($,"failed")
 
+                 retractIfCan : Polynomial(Integer) -> Union(%,"failed")
                  retractIfCan(pz:PZ) ==
                    pr : PR := PZToPR(pz)
                    retractIfCan(pr)@Union($,"failed")
 
+                 retract : Polynomial(R) -> %
                  retract(pr:PR) ==
                    rif : Union($,"failed") := _
                                           retractIfCan(pr)@Union($,"failed")
@@ -67366,30 +78040,44 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
                                 "failed in retract: POLY Z -> $ from RPOLCAT"
                    rif::$
 
+                 convert : Polynomial(R) -> %
                  convert(pr:PR) ==
                    retract(pr)@$
 
                else
+
                  -- the only operation to implement is 
                  -- retractIfCan : PQ -> Union($,"failed")
                  -- when V does not have Finite
                  mpc2ZQ := MPolyCatFunctions2(Symbol,IES,IES,Z,Q,PZ,PQ)
                  mpc2RQ := MPolyCatFunctions2(Symbol,IES,IES,R,Q,PR,PQ)
+
+                 ZToQ : Z -> Q
                  ZToQ(z:Z):Q == coerce(z)@Q
+
+                 RToQ : R -> Q
                  RToQ(r:R):Q == retract(r)@Q
 
+                 PZToPQ : PZ -> PQ
                  PZToPQ (pz:PZ):PQ == map(ZToQ,pz)$mpc2ZQ
+
+                 PRToPQ : PR -> PQ
                  PRToPQ (pr:PR):PQ == map(RToQ,pr)$mpc2RQ
 
+                 retractIfCan : Polynomial(Integer) -> Union(%,"failed")
                  retractIfCan(pz:PZ) ==
                    pq : PQ := PZToPQ(pz)
                    retractIfCan(pq)@Union($,"failed")
 
                  if V has Finite
                    then
+
+                     retractIfCan : Polynomial(Fraction(Integer)) ->
+                        Union(%,"failed")
                      retractIfCan(pq:PQ) ==
                        localRetractIfCanPQ(pq)@Union($,"failed")
 
+                     convert : Polynomial(R) -> %
                      convert(pr:PR) ==
                        lrif : Union($,"failed") := _
                                        localRetractIfCan(pr)@Union($,"failed")
@@ -67397,6 +78085,8 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
                                        "failed in convert: PR->$ from RPOLCAT"
                        lrif::$
                    else
+
+                     convert : Polynomial(R) -> %
                      convert(pr:PR) ==
                        pq : PQ := PRToPQ(pr)
                        retract(pq)@$
@@ -67405,15 +78095,21 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
            then 
 
              mpc2Z := MPolyCatFunctions2(Symbol,IES,IES,Z,R,PZ,PR)
+
+             ZToR : Z -> R
              ZToR (z:Z):R == coerce(z)@R
+
+             PZToPR : PZ -> PR
              PZToPR (pz:PZ):PR == map(ZToR,pz)$mpc2Z
 
+             retract : Polynomial(Integer) -> %
              retract(pz:PZ) ==
                rif : Union($,"failed") := retractIfCan(pz)@Union($,"failed")
                (rif case "failed") => error _
                                  "failed in retract: POLY Z -> $ from RPOLCAT"
                rif::$
 
+             convert : Polynomial(Integer) -> %
              convert(pz:PZ) ==
                retract(pz)@$
 
@@ -67425,22 +78121,32 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
 
                  if V has Finite
                    then
+
+                     retractIfCan : Polynomial(R) -> Union(%,"failed")
                      retractIfCan(pr:PR) ==
                        localRetractIfCan(pr)@Union($,"failed")
 
+                     retractIfCan : Polynomial(Fraction(Integer)) ->
+                         Union(%,"failed")
                      retractIfCan(pz:PZ) ==
                        localRetractIfCanPZ(pz)@Union($,"failed")
+
                    else
+
+                     retractIfCan : Polynomial(Fraction(Integer)) ->
+                         Union(%,"failed")
                      retractIfCan(pz:PZ) ==
                        pr : PR := PZToPR(pz)
                        retractIfCan(pr)@Union($,"failed")
 
+                 retract : Polynomial(R) -> %
                  retract(pr:PR) ==
                    rif : Union($,"failed"):=retractIfCan(pr)@Union($,"failed")
                    (rif case "failed") => error _
                                   "failed in retract: POLY Z -> $ from RPOLCAT"
                    rif::$
 
+                 convert : % -> Polynomial(R)
                  convert(pr:PR) ==
                    retract(pr)@$
 
@@ -67450,20 +78156,31 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
                  -- when V does not have Finite
 
                  mpc2RZ := MPolyCatFunctions2(Symbol,IES,IES,R,Z,PR,PZ)
+
+                 RToZ : R -> Z
                  RToZ(r:R):Z == retract(r)@Z
+
+                 PRToPZ : PR -> PZ
                  PRToPZ (pr:PR):PZ == map(RToZ,pr)$mpc2RZ
 
                  if V has Finite
                    then
+
+                     convert : % -> Polynomial(R)
                      convert(pr:PR) ==
                        lrif : Union($,"failed") := _
                                        localRetractIfCan(pr)@Union($,"failed")
                        (lrif case "failed") => error _
                                        "failed in convert: PR->$ from RPOLCAT"
                        lrif::$
+
+                     retractIfCan : Polynomial(Integer) -> Union(%,"failed")
                      retractIfCan(pz:PZ) ==
                        localRetractIfCanPZ(pz)@Union($,"failed")
+
                    else
+
+                     convert : % -> Polynomial(R)
                      convert(pr:PR) ==
                        pz : PZ := PRToPZ(pr)
                        retract(pz)@$
@@ -67476,21 +78193,26 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
 
              if V has Finite
                then
+
+                 retractIfCan : Polynomial(R) -> Union(%,"failed")
                  retractIfCan(pr:PR) ==
                    localRetractIfCan(pr)@Union($,"failed")
 
+             retract : Polynomial(R) -> %
              retract(pr:PR) ==
                rif : Union($,"failed") := retractIfCan(pr)@Union($,"failed")
                (rif case "failed") => error _
                                "failed in retract: POLY Z -> $ from RPOLCAT"
                rif::$
 
+             convert : % -> Polynomial(R)
              convert(pr:PR) ==
                retract(pr)@$
 
          if (R has RetractableTo(INT))
            then
 
+             convert : % -> String
              convert(pol:$):String ==
                ground?(pol) => convert(retract(ground(pol))@INT)@String
                ipol : $ := init(pol)
@@ -67498,12 +78220,10 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
                dpol : NNI := mdeg(pol)
                tpol: $  := tail(pol)
                sipol,svpol,sdpol,stpol : String
---               if one? ipol
                if (ipol = 1)
                  then 
                    sipol := empty()$String
                  else
---                   if one?(-ipol)
                    if ((-ipol) = 1)
                      then 
                        sipol := "-"
@@ -67515,7 +78235,6 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
                          else 
                            sipol := concat(sipol,"*")$String
                svpol := string(convert(vpol)@Symbol)
---               if one? dpol
                if (dpol = 1)
                  then
                    sdpol :=  empty()$String
@@ -67542,13 +78261,17 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
                            stpol :=  concat(" + ",stpol)$String
                concat([sipol,svpol,sdpol,stpol])$String
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{RPOLCAT.dotabb}
 "RPOLCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RPOLCAT"];
 "RPOLCAT" -> "POLYCAT"
 
 \end{chunk}
+
 \begin{chunk}{RPOLCAT.dotfull}
 "RecursivePolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=RPOLCAT"];
@@ -67556,6 +78279,7 @@ RecursivePolynomialCategory(R:Ring, E:OrderedAbelianMonoidSup, V:OrderedSet):_
  -> "PolynomialCategory(a:Ring,b:OrderedAbelianMonoidSup,c:OrderedSet)"
 
 \end{chunk}
+
 \begin{chunk}{RPOLCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -67610,6 +78334,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{UnivariateLaurentSeriesCategory}{ULSCAT}
 \pagepic{ps/v102univariatelaurentseriescategory.ps}{ULSCAT}{0.50}
@@ -67761,6 +78486,7 @@ rationalFunction(w,0)
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{UnivariateLaurentSeriesCategory.help}
 ====================================================================
 UnivariateLaurentSeriesCategory examples
@@ -68198,6 +78924,7 @@ UnivariateLaurentSeriesCategory(Coef): Category == Definition where
         --++ In fact, K((x)) is the quotient field of K[[x]].
 
 \end{chunk}
+
 \begin{chunk}{ULSCAT.dotabb}
 "ULSCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ULSCAT"];
@@ -68207,6 +78934,7 @@ UnivariateLaurentSeriesCategory(Coef): Category == Definition where
 "ULSCAT" -> "RADCAT"
 
 \end{chunk}
+
 \begin{chunk}{ULSCAT.dotfull}
 "UnivariateLaurentSeriesCategory(a:Ring)" 
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ULSCAT"];
@@ -68220,6 +78948,7 @@ UnivariateLaurentSeriesCategory(Coef): Category == Definition where
     "UnivariatePowerSeriesCategory(a:Ring,Integer)"
 
 \end{chunk}
+
 \begin{chunk}{ULSCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -68262,6 +78991,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{UnivariatePuiseuxSeriesCategory}{UPXSCAT}
 \pagepic{ps/v102univariatepuiseuxseriescategory.ps}{UPXSCAT}{0.50}
@@ -68406,6 +79136,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{UnivariatePuiseuxSeriesCategory.help}
 ====================================================================
 UnivariatePuiseuxSeriesCategory examples
@@ -68809,6 +79540,7 @@ UnivariatePuiseuxSeriesCategory(Coef): Category == Definition where
         --++ Univariate Puiseux series over a field form a field.
 
 \end{chunk}
+
 \begin{chunk}{UPXSCAT.dotabb}
 "UPXSCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=UPXSCAT"];
@@ -68818,6 +79550,7 @@ UnivariatePuiseuxSeriesCategory(Coef): Category == Definition where
 "UPXSCAT" -> "UPSCAT"
 
 \end{chunk}
+
 \begin{chunk}{UPXSCAT.dotfull}
 "UnivariatePuiseuxSeriesCategory(a:Ring)" 
  [color=lightblue,href="bookvol10.2.pdf#nameddest=UPXSCAT"];
@@ -68831,6 +79564,7 @@ UnivariatePuiseuxSeriesCategory(Coef): Category == Definition where
     "RadicalCategory()"
 
 \end{chunk}
+
 \begin{chunk}{UPXSCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -68873,6 +79607,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{UnivariatePolynomialCategory}{UPOLYC}
 \pagepic{ps/v102univariatepolynomialcategory.ps}{UPOLYC}{0.35}
@@ -69085,6 +79820,7 @@ t3:UP(x,FRAC(INT)):=unvectorise(t2)
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{UnivariatePolynomialCategory.help}
 ====================================================================
 UnivariatePolynomialCategory examples
@@ -70006,6 +80742,370 @@ UnivariatePolynomialCategory(R:Ring): Category ==
         ans
 
 \end{chunk}
+
+\begin{chunk}{COQ UPOLYC}
+(* category UPOLYC *)
+(*
+    pp,qq: SparseUnivariatePolynomial %
+
+    variables : % -> List(SingletonAsOrderedSet)
+    variables(p) ==
+      zero? p or zero?(degree p) => []
+      [create()]
+
+    degree : (%,List(SingletonAsOrderedSet)) -> List(NonNegativeInteger)
+    degree(p:%,v:SingletonAsOrderedSet) == degree p
+
+    totalDegree : (%,List(SingletonAsOrderedSet)) -> NonNegativeInteger
+    totalDegree(p:%,lv:List SingletonAsOrderedSet) ==
+       empty? lv => 0
+       totalDegree p
+
+    degree : (%,List(SingletonAsOrderedSet)) -> List(NonNegativeInteger)
+    degree(p:%,lv:List SingletonAsOrderedSet) ==
+       empty? lv => []
+       [degree p]
+
+    eval : (%,List(SingletonAsOrderedSet),List(%)) -> %
+    eval(p:%,lv: List SingletonAsOrderedSet,lq: List %):% ==
+      empty? lv => p
+      not empty? rest lv => _
+        error "can only eval a univariate polynomial once"
+      eval(p,first lv,first lq)$%
+
+    eval : (%,SingletonAsOrderedSet,%) -> %
+    eval(p:%,v:SingletonAsOrderedSet,q:%):% == p(q)
+
+    eval(p:%,lv: List SingletonAsOrderedSet,lr: List R):% ==
+      empty? lv => p
+      not empty? rest lv => _
+         error "can only eval a univariate polynomial once"
+      eval(p,first lv,first lr)$%
+
+    eval : (%,List(SingletonAsOrderedSet),List(R)) -> %
+    eval(p:%,v:SingletonAsOrderedSet,r:R):% == p(r)::%
+
+    eval : (%,List(Equation(%))) -> %
+    eval(p:%,le:List Equation %):% == 
+      empty? le  => p
+      not empty? rest le => _
+         error "can only eval a univariate polynomial once"
+      mainVariable(lhs first le) case "failed" => p
+      p(rhs first le)
+
+    mainVariable : % -> Union(SingletonAsOrderedSet,"failed")
+    mainVariable(p:%) ==
+      zero? degree p =>  "failed"
+      create()$SingletonAsOrderedSet
+
+    minimumDegree : (%,SingletonAsOrderedSet) -> NonNegativeInteger
+    minimumDegree(p:%,v:SingletonAsOrderedSet) == minimumDegree p
+
+    minimumDegree : (%,List(SingletonAsOrderedSet)) -> List(NonNegativeInteger)
+    minimumDegree(p:%,lv:List SingletonAsOrderedSet) ==
+       empty? lv => []
+       [minimumDegree p]
+
+    monomial : (%,SingletonAsOrderedSet,NonNegativeInteger) -> %
+    monomial(p:%,v:SingletonAsOrderedSet,n:NonNegativeInteger) ==
+       mapExponents(x1+->x1+n,p)
+
+    coerce : SingletonAsOrderedSet -> %
+    coerce(v:SingletonAsOrderedSet):% == monomial(1,1)
+
+    makeSUP : % -> SparseUnivariatePolynomial(R)
+    makeSUP p ==
+      zero? p => 0
+      monomial(leadingCoefficient p,degree p) + makeSUP reductum p
+
+    unmakeSUP : SparseUnivariatePolynomial(R) -> %
+    unmakeSUP sp ==
+      zero? sp => 0
+      monomial(leadingCoefficient sp,degree sp) + unmakeSUP reductum sp
+
+    karatsubaDivide: (%,NonNegativeInteger) -> Record(quotient: %,remainder: %)
+    karatsubaDivide(p:%,n:NonNegativeInteger) == monicDivide(p,monomial(1,n))
+
+    shiftRight : (%,NonNegativeInteger) -> %
+    shiftRight(p:%,n:NonNegativeInteger) == 
+       monicDivide(p,monomial(1,n)).quotient
+
+    shiftLeft : (%,NonNegativeInteger) -> %
+    shiftLeft(p:%,n:NonNegativeInteger) == p * monomial(1,n)
+
+    if R has PolynomialFactorizationExplicit then
+
+       PFBRU ==> PolynomialFactorizationByRecursionUnivariate(R,%)
+
+       pp,qq:SparseUnivariatePolynomial %
+
+       lpp:List SparseUnivariatePolynomial %
+
+       SupR ==> SparseUnivariatePolynomial R
+
+       sp:SupR
+
+       solveLinearPolynomialEquation :
+        (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) ->
+           Union(List(SparseUnivariatePolynomial(%)),"failed") if R has PFECAT
+       solveLinearPolynomialEquation(lpp,pp) ==
+         solveLinearPolynomialEquationByRecursion(lpp,pp)$PFBRU
+
+       factorPolynomial : SparseUnivariatePolynomial(%) ->
+          Factored(SparseUnivariatePolynomial(%))
+       factorPolynomial(pp) ==
+         factorByRecursion(pp)$PFBRU
+
+       factorSquareFreePolynomial : SparseUnivariatePolynomial(%) ->
+           Factored(SparseUnivariatePolynomial(%))
+       factorSquareFreePolynomial(pp) ==
+         factorSquareFreeByRecursion(pp)$PFBRU
+
+       import FactoredFunctions2(SupR,S)
+
+       factor : % -> Factored(%)
+       factor p ==
+         zero? degree p  =>
+           ansR:=factor leadingCoefficient p
+           makeFR(unit(ansR)::%,
+                  [[w.flg,w.fctr::%,w.xpnt] for w in factorList ansR])
+         map(unmakeSUP,factorPolynomial(makeSUP p)$R)
+
+    vectorise : (%,NonNegativeInteger) -> Vector(R)
+    vectorise(p, n) ==
+      m := minIndex(v := new(n, 0)$Vector(R))
+      for i in minIndex v .. maxIndex v repeat
+        qsetelt_!(v, i, coefficient(p, (i - m)::NonNegativeInteger))
+      v
+
+    unvectorise : Vector(R) -> %
+    unvectorise(v : Vector R) : % ==
+        p : % := 0
+        for i in 1..#v repeat
+            p := p + monomial(v(i), (i-1)::NonNegativeInteger)
+        p
+
+    retract : % -> R
+    retract(p:%):R ==
+      zero? p => 0
+      zero? degree p => leadingCoefficient p
+      error "Polynomial is not of degree 0"
+
+    retractIfCan : % -> Union(R,"failed")
+    retractIfCan(p:%):Union(R, "failed") ==
+      zero? p => 0
+      zero? degree p => leadingCoefficient p
+      "failed"
+
+    if R has StepThrough then
+
+       init : () -> %
+       init() == init()$R::%
+
+       nextItemInner: % -> Union(%,"failed")
+       nextItemInner(n) ==
+         zero? n => nextItem(0$R)::R::% -- assumed not to fail
+         zero? degree n =>
+           nn:=nextItem leadingCoefficient n
+           nn case "failed" => "failed"
+           nn::R::%
+         n1:=reductum n
+         n2:=nextItemInner n1 -- try stepping the reductum
+         n2 case % => monomial(leadingCoefficient n,degree n) + n2
+         1+degree n1 < degree n => -- there was a hole between lt n and n1
+           monomial(leadingCoefficient n,degree n)+
+             monomial(nextItem(init()$R)::R,1+degree n1)
+         n3:=nextItem leadingCoefficient n
+         n3 case "failed" => "failed"
+         monomial(n3,degree n)
+
+       nextItem : % -> Union(%,"failed")
+       nextItem(n) ==
+         n1:=nextItemInner n
+         n1 case "failed" => monomial(nextItem(init()$R)::R,1+degree(n))
+         n1
+
+    if R has GcdDomain then
+
+      content : (%,SingletonAsOrderedSet) -> %
+      content(p:%,v:SingletonAsOrderedSet) == content(p)::%
+
+      primeFactor: (%, %) -> %
+      primeFactor(p, q) ==
+        (p1 := (p exquo gcd(p, q))::%) = p => p
+        primeFactor(p1, q)
+
+      separate : (%,%) -> Record(primePart: %,commonPart: %)
+      separate(p, q) ==
+        a := primeFactor(p, q)
+        [a, (p exquo a)::%]
+
+    if R has CommutativeRing then
+
+      differentiate : (%,(R -> R),%) -> %
+      differentiate(x:%, deriv:R -> R, x':%) ==
+        d:% := 0
+        while (dg := degree x) > 0 repeat
+          lc := leadingCoefficient x
+          d := d + x' * monomial(dg * lc, (dg - 1)::NonNegativeInteger)
+                 + monomial(deriv lc, dg)
+          x := reductum x
+        d + deriv(leadingCoefficient x)::%
+
+    else
+
+      -- computes d(x**n) given dx = x', non-commutative case
+      ncdiff: (NonNegativeInteger, %) -> %
+      ncdiff(n, x') ==
+        zero? n => 0
+        zero?(n1 := (n - 1)::NonNegativeInteger) => x'
+        x' * monomial(1, n1) + monomial(1, 1) * ncdiff(n1, x')
+
+      differentiate : (%,(R -> R),%) -> %
+      differentiate(x:%, deriv:R -> R, x':%) ==
+        d:% := 0
+        while (dg := degree x) > 0 repeat
+          lc := leadingCoefficient x
+          d := d + monomial(deriv lc, dg) + lc * ncdiff(dg, x')
+          x := reductum x
+        d + deriv(leadingCoefficient x)::%
+
+    differentiate : (%,(R -> R)) -> %
+    differentiate(x:%, deriv:R -> R) == differentiate(x, deriv, 1$%)$%
+
+    differentiate : % -> %
+    differentiate(x:%) ==
+        d:% := 0
+        while (dg := degree x) > 0 repeat
+          d:=d+monomial(dg*leadingCoefficient x,(dg-1)::NonNegativeInteger)
+          x := reductum x
+        d
+
+    differentiate : (%,SingletonAsOrderedSet) -> %
+    differentiate(x:%,v:SingletonAsOrderedSet) == differentiate x
+
+    if R has IntegralDomain then
+
+      elt : (Fraction(%),Fraction(%)) -> Fraction(%)
+      elt(g:Fraction %, f:Fraction %) == ((numer g) f) / ((denom g) f)
+
+      pseudoQuotient : (%,%) -> %
+      pseudoQuotient(p, q) ==
+        (n := degree(p)::Integer - degree q + 1) < 1 => 0
+        ((leadingCoefficient(q)**(n::NonNegativeInteger) * p
+          - pseudoRemainder(p, q)) exquo q)::%
+
+      pseudoDivide : (%,%) -> Record(coef: R,quotient: %,remainder: %)
+      pseudoDivide(p, q) ==
+        (n := degree(p)::Integer - degree q + 1) < 1 => [1, 0, p]
+        prem := pseudoRemainder(p, q)
+        lc   := leadingCoefficient(q)**(n::NonNegativeInteger)
+        [lc,((lc*p - prem) exquo q)::%, prem]
+
+      composite : (Fraction(%),%) -> Union(Fraction(%),"failed")
+      composite(f:Fraction %, q:%) ==
+        (n := composite(numer f, q)) case "failed" => "failed"
+        (d := composite(denom f, q)) case "failed" => "failed"
+        n::% / d::%
+
+      composite : (%,%) -> Union(%,"failed") 
+      composite(p:%, q:%) ==
+        ground? p => p
+        cqr := pseudoDivide(p, q)
+        ground?(cqr.remainder) and
+          ((v := cqr.remainder exquo cqr.coef) case %) and
+            ((u := composite(cqr.quotient, q)) case %) and
+              ((w := (u::%) exquo cqr.coef) case %) =>
+                v::% + monomial(1, 1) * w::%
+        "failed"
+
+      ?.? : (%,R) -> R
+      elt(p:%, f:Fraction %) ==
+        zero? p => 0
+        ans:Fraction(%) := (leadingCoefficient p)::%::Fraction(%)
+        n := degree p
+        while not zero?(p:=reductum p) repeat
+          ans := ans * f ** (n - (n := degree p))::NonNegativeInteger +
+                    (leadingCoefficient p)::%::Fraction(%)
+        zero? n => ans
+        ans * f ** n
+
+      order : (%,%) -> NonNegativeInteger
+      order(p, q) ==
+        zero? p => error "order: arguments must be nonzero"
+        degree(q) < 1 => error "order: place must be non-trivial"
+        ans:NonNegativeInteger := 0
+        repeat
+          (u  := p exquo q) case "failed" => return ans
+          p   := u::%
+          ans := ans + 1
+
+    if R has GcdDomain then
+
+      squareFree : % -> Factored(%)
+      squareFree(p:%) ==
+        squareFree(p)$UnivariatePolynomialSquareFree(R, %)
+
+      squareFreePart : % -> %
+      squareFreePart(p:%) ==
+        squareFreePart(p)$UnivariatePolynomialSquareFree(R, %)
+
+    if R has PolynomialFactorizationExplicit then
+
+      gcdPolynomial : 
+        (SparseUnivariatePolynomial(%),
+         SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
+      gcdPolynomial(pp,qq) ==
+            zero? pp => unitCanonical qq  -- subResultantGcd can't handle 0
+            zero? qq => unitCanonical pp
+            unitCanonical(gcd(content (pp),content(qq))*
+                   primitivePart
+                      subResultantGcd(primitivePart pp,primitivePart qq))
+
+      squareFreePolynomial : SparseUnivariatePolynomial(%) ->
+          Factored(SparseUnivariatePolynomial(%))
+      squareFreePolynomial pp ==
+         squareFree(pp)$UnivariatePolynomialSquareFree(%,
+                                    SparseUnivariatePolynomial %)
+
+    if R has Field then
+
+      elt : (Fraction(%),R) -> R
+      elt(f:Fraction %, r:R) == ((numer f) r) / ((denom f) r)
+
+      euclideanSize : % -> NonNegativeInteger
+      euclideanSize x ==
+            zero? x =>
+              error "euclideanSize called on 0 in Univariate Polynomial"
+            degree x
+
+      divide : (%,%) -> Record(quotient: %,remainder: %)
+      divide(x,y) ==
+            zero? y => error "division by 0 in Univariate Polynomials"
+            quot:=0
+            lc := inv leadingCoefficient y
+            while not zero?(x) and (degree x >= degree y) repeat
+               f:=lc*leadingCoefficient x
+               n:=(degree x - degree y)::NonNegativeInteger
+               quot:=quot+monomial(f,n)
+               x:=x-monomial(f,n)*y
+            [quot,x]
+
+    if R has Algebra Fraction Integer then
+
+      integrate : % -> %
+      integrate p ==
+        ans:% := 0
+        while p ^= 0 repeat
+          l := leadingCoefficient p
+          d := 1 + degree p
+          ans := ans + inv(d::Fraction(Integer)) * monomial(l, d)
+          p := reductum p
+        ans
+*)
+
+\end{chunk}
+
 \begin{chunk}{UPOLYC.dotabb}
 "UPOLYC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=UPOLYC"];
@@ -70022,6 +81122,7 @@ UnivariatePolynomialCategory(R:Ring): Category ==
 "UPOLYC" -> "PFECAT"
 
 \end{chunk}
+
 \begin{chunk}{UPOLYC.dotfull}
 "UnivariatePolynomialCategory(a:Ring)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=UPOLYC"];
@@ -70051,6 +81152,7 @@ UnivariatePolynomialCategory(R:Ring): Category ==
    "PolynomialFactorizationExplicit()"
 
 \end{chunk}
+
 \begin{chunk}{UPOLYC.dotpic}
 digraph pic {
  fontsize=10;
@@ -70085,6 +81187,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 17}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{AlgebraicallyClosedFunctionSpace}{ACFS}
@@ -70267,6 +81370,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{AlgebraicallyClosedFunctionSpace.help}
 ====================================================================
 AlgebraicallyClosedFunctionSpace examples
@@ -70782,6 +81886,78 @@ AlgebraicallyClosedFunctionSpace(R:Join(OrderedSet, IntegralDomain)):
       zeroOf(p, y)$AlgebraicallyClosedField_&($)
 
 \end{chunk}
+
+\begin{chunk}{COQ ACFS}
+(* category ACFS *)
+(*
+
+    rootOf : % -> %
+    rootOf(p:$) ==
+      empty?(l := variables p) => error "rootOf: constant expression"
+      rootOf(p, first l)
+
+    rootsOf : % -> List(%)
+    rootsOf(p:$) ==
+      empty?(l := variables p) => error "rootsOf: constant expression"
+      rootsOf(p, first l)
+
+    zerosOf : % -> List(%)
+    zeroOf(p:$) ==
+      empty?(l := variables p) => error "zeroOf: constant expression"
+      zeroOf(p, first l)
+
+    zerosOf : % -> List(%)
+    zerosOf(p:$) ==
+      empty?(l := variables p) => error "zerosOf: constant expression"
+      zerosOf(p, first l)
+
+    zeroOf : (%,Symbol) -> %
+    zeroOf(p:$, x:Symbol) ==
+      n := numer(f := univariate(p, kernel(x)$Kernel($)))
+      degree denom f > 0 => error "zeroOf: variable appears in denom"
+      degree n = 0 => error "zeroOf: constant expression"
+      zeroOf(n, x)
+
+    rootOf : (%,Symbol) -> %
+    rootOf(p:$, x:Symbol) ==
+      n := numer(f := univariate(p, kernel(x)$Kernel($)))
+      degree denom f > 0 => error "roofOf: variable appears in denom"
+      degree n = 0 => error "rootOf: constant expression"
+      rootOf(n, x)
+
+    zerosOf : (%,Symbol) -> List(%)
+    zerosOf(p:$, x:Symbol) ==
+      n := numer(f := univariate(p, kernel(x)$Kernel($)))
+      degree denom f > 0 => error "zerosOf: variable appears in denom"
+      degree n = 0 => empty()
+      zerosOf(n, x)
+
+    rootsOf : (%,Symbol) -> List(%)
+    rootsOf(p:$, x:Symbol) ==
+      n := numer(f := univariate(p, kernel(x)$Kernel($)))
+      degree denom f > 0 => error "roofsOf: variable appears in denom"
+      degree n = 0 => empty()
+      rootsOf(n, x)
+
+    rootsOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%)
+    rootsOf(p:SparseUnivariatePolynomial $, y:Symbol) ==
+      (r := retractIfCan(p)@Union($,"failed")) case $ => rootsOf(r::$,y)
+      rootsOf(p, y)$AlgebraicallyClosedField_&($)
+
+    zerosOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%)
+    zerosOf(p:SparseUnivariatePolynomial $, y:Symbol) ==
+      (r := retractIfCan(p)@Union($,"failed")) case $ => zerosOf(r::$,y)
+      zerosOf(p, y)$AlgebraicallyClosedField_&($)
+
+    zeroOf : (SparseUnivariatePolynomial(%),Symbol) -> %
+    zeroOf(p:SparseUnivariatePolynomial $, y:Symbol) ==
+      (r := retractIfCan(p)@Union($,"failed")) case $ => zeroOf(r::$, y)
+      zeroOf(p, y)$AlgebraicallyClosedField_&($)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ACFS.dotabb}
 "ACFS"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ACFS"];
@@ -70789,6 +81965,7 @@ AlgebraicallyClosedFunctionSpace(R:Join(OrderedSet, IntegralDomain)):
 "ACFS" -> "FS"
 
 \end{chunk}
+
 \begin{chunk}{ACFS.dotfull}
 "AlgebraicallyClosedFunctionSpace(a:Join(OrderedSet,IntegralDomain))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ACFS"];
@@ -70798,6 +81975,7 @@ AlgebraicallyClosedFunctionSpace(R:Join(OrderedSet, IntegralDomain)):
   -> "FunctionSpace(a:OrderedSet)"
 
 \end{chunk}
+
 \begin{chunk}{ACFS.dotpic}
 digraph pic {
  fontsize=10;
@@ -70851,6 +82029,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{ExtensionField}{XF}
 \pagepic{ps/v102extensionfield.ps}{XF}{0.75}
@@ -70929,6 +82108,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ExtensionField.help}
 ====================================================================
 ExtensionField examples
@@ -71194,6 +82374,31 @@ ExtensionField(F:Field) : Category  == _
       Frobenius(a,s) == a ** (size()$F ** s)
 
 \end{chunk}
+
+\begin{chunk}{COQ XF}
+(* category XF *)
+(*
+
+    algebraic? : % -> Boolean
+    algebraic?(a) == not infinite? (degree(a)@OnePointCompletion_
+      (PositiveInteger))$OnePointCompletion(PositiveInteger)
+
+    transcendent? : % -> Boolean
+    transcendent? a == infinite?(degree(a)@OnePointCompletion _
+      (PositiveInteger))$OnePointCompletion(PositiveInteger)
+
+    if F has Finite then
+
+      Frobenius : % -> %
+      Frobenius(a) == a ** size()$F
+
+      Frobenius : (%,NonNegativeInteger) -> %
+      Frobenius(a,s) == a ** (size()$F ** s)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{XF.dotabb}
 "XF"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=XF"];
@@ -71203,6 +82408,7 @@ ExtensionField(F:Field) : Category  == _
 "XF" -> "FPC"
 
 \end{chunk}
+
 \begin{chunk}{XF.dotfull}
 "ExtensionField(a:Field)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=XF"];
@@ -71212,6 +82418,7 @@ ExtensionField(F:Field) : Category  == _
 "ExtensionField(a:Field)" -> "FieldOfPrimeCharacteristic()"
 
 \end{chunk}
+
 \begin{chunk}{XF.dotpic}
 digraph pic {
  fontsize=10;
@@ -71258,6 +82465,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FiniteFieldCategory}{FFIELDC}
 \pagepic{ps/v102finitefieldcategory.ps}{FFIELDC}{0.70}
@@ -71339,6 +82547,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FiniteFieldCategory.help}
 ====================================================================
 FiniteFieldCategory examples
@@ -71572,7 +82781,6 @@ These exports come from \refto{DifferentialRing}():
 
 FiniteFieldCategory() : Category ==_
   Join(FieldOfPrimeCharacteristic,Finite,StepThrough,DifferentialRing) with
---                 ,PolynomialFactorizationExplicit) with
     charthRoot: $ -> $
       ++ charthRoot(a) takes the characteristic'th root of a.
       ++ Note that such a root is alway defined in finite fields.
@@ -71678,7 +82886,6 @@ FiniteFieldCategory() : Category ==_
       q:=(size()-1)@Integer
       equalone : Boolean := false
       for exp in explist while not equalone repeat
---        equalone := one?(a**(q quo exp.factor))
         equalone := ((a**(q quo exp.factor)) = 1)
       not equalone
 
@@ -71689,7 +82896,6 @@ FiniteFieldCategory() : Category ==_
       lof:=factorsOfCyclicGroupSize()
       for rec in lof repeat -- run through prime divisors
         a := ord quo (primeDivisor := rec.factor)
---        goon := one?(e**a)
         goon := ((e**a) = 1)
         -- run through exponents of the prime divisors
         for j in 0..(rec.exponent)-2 while goon repeat
@@ -71697,7 +82903,6 @@ FiniteFieldCategory() : Category ==_
           -- continue dividing by primeDivisor
           ord := a
           a := ord quo primeDivisor
---          goon := one?(e**a)
           goon := ((e**a) = 1)
         if goon then ord := a
         -- as we do a top down search we have found the
@@ -71776,21 +82981,208 @@ FiniteFieldCategory() : Category ==_
     FRP ==> Factored FP
     f,g:FP
 
+-- TPDHERE: why is this here? It isn't exported.
+    squareFreePolynomial(f:FP):FRP ==
+          squareFree(f)$UnivariatePolynomialSquareFree($,FP)
+
+-- TPDHERE: why is this here? It isn't exported.
+    factorPolynomial(f:FP):FRP == factor(f)$DistinctDegreeFactorize($,FP)
+
+-- TPDHERE: why is this here? It isn't exported.
+    factorSquareFreePolynomial(f:FP):FRP ==
+        f = 0 => 0
+        flist := distdfact(f,true)$DistinctDegreeFactorize($,FP)
+        (flist.cont :: FP) *
+            (*/[primeFactor(u.irr,u.pow) for u in flist.factors])
+
+    gcdPolynomial(f:FP,g:FP):FP ==
+         gcd(f,g)$EuclideanDomain_&(FP)
+
+\end{chunk}
+
+\begin{chunk}{COQ FFIELDC}
+(* category FFIELDC *)
+(*
+    I   ==> Integer
+    PI  ==> PositiveInteger
+    NNI ==> NonNegativeInteger
+    SUP ==> SparseUnivariatePolynomial
+    DLP ==> DiscreteLogarithmPackage
+
+    -- exported functions
+
+    differentiate : % -> %
+    differentiate x == 0
+
+    init : () -> %
+    init() == 0
+
+    nextItem : % -> Union(%,"failed")
+    nextItem(a) ==
+      zero?(a:=index(lookup(a)+1)) => "failed"
+      a
+
+    order : % -> OnePointCompletion(PositiveInteger)
+    order(e):OnePointCompletion(PositiveInteger) ==
+      (order(e)@PI)::OnePointCompletion(PositiveInteger)
+
+    conditionP : Matrix(%) -> Union(Vector(%),"failed")
+    conditionP(mat:Matrix $) ==
+      l:=nullSpace mat
+      empty? l or every?(zero?, first l) => "failed"
+      map(charthRoot,first l)
+
+    charthRoot : % -> %
+    charthRoot(x:$):$ == x**(size() quo characteristic())
+
+    charthRoot : % -> Union(%,"failed")
+    charthRoot(x:%):Union($,"failed") ==
+        (charthRoot(x)@$)::Union($,"failed")
+
+    createPrimitiveElement : () -> %
+    createPrimitiveElement() ==
+      sm1  : PositiveInteger := (size()$$-1) pretend PositiveInteger
+      start : Integer :=
+        -- in the polynomial case, index from 1 to characteristic-1
+        -- gives prime field elements
+        representationType = "polynomial" => characteristic()::Integer
+        1
+      found : Boolean := false
+      for i in start..  while not found repeat
+        e : $ := index(i::PositiveInteger)
+        found := (order(e) = sm1)
+      e
+
+    primitive? : % -> Boolean
+    primitive? a ==
+      -- add special implementation for prime field case
+      zero?(a) => false
+      explist := factorsOfCyclicGroupSize()
+      q:=(size()-1)@Integer
+      equalone : Boolean := false
+      for exp in explist while not equalone repeat
+        equalone := ((a**(q quo exp.factor)) = 1)
+      not equalone
+
+    order : % -> PositiveInteger
+    order e ==
+      e = 0 => error "order(0) is not defined "
+      ord:Integer:= size()-1 -- order e divides ord
+      a:Integer:= 0
+      lof:=factorsOfCyclicGroupSize()
+      for rec in lof repeat -- run through prime divisors
+        a := ord quo (primeDivisor := rec.factor)
+        goon := ((e**a) = 1)
+        -- run through exponents of the prime divisors
+        for j in 0..(rec.exponent)-2 while goon repeat
+          -- as long as we get (e**ord = 1) we
+          -- continue dividing by primeDivisor
+          ord := a
+          a := ord quo primeDivisor
+          goon := ((e**a) = 1)
+        if goon then ord := a
+        -- as we do a top down search we have found the
+        -- correct exponent of primeDivisor in order e
+        -- and continue with next prime divisor
+      ord pretend PositiveInteger
+
+    discreteLog : % -> NonNegativeInteger
+    discreteLog(b) ==
+      zero?(b) => error "discreteLog: logarithm of zero"
+      faclist:=factorsOfCyclicGroupSize()
+      a:=b
+      gen:=primitiveElement()
+      -- in GF(2) its necessary to have discreteLog(1) = 1
+      b = gen => 1
+      disclog:Integer:=0
+      mult:Integer:=1
+      groupord := (size() - 1)@Integer
+      exp:Integer:=groupord
+      for f in faclist repeat
+        fac:=f.factor
+        for t in 0..f.exponent-1 repeat
+          exp:=exp quo fac
+          -- shanks discrete logarithm algorithm
+          exptable:=tableForDiscreteLogarithm(fac)
+          n:=#exptable
+          c:=a**exp
+          end:=(fac - 1) quo n
+          found:=false
+          disc1:Integer:=0
+          for i in 0..end while not found repeat
+            rho:= search(lookup(c),exptable)_
+                  $Table(PositiveInteger,NNI)
+            rho case NNI =>
+              found := true
+              disc1:=((n * i + rho)@Integer) * mult
+            c:=c* gen**((groupord quo fac) * (-n))
+          not found => error "discreteLog: ?? discrete logarithm"
+          -- end of shanks discrete logarithm algorithm
+          mult := mult * fac
+          disclog:=disclog+disc1
+          a:=a * (gen ** (-disc1))
+      disclog pretend NonNegativeInteger
+
+    discreteLog : (%,%) -> Union(NonNegativeInteger,"failed")
+    discreteLog(logbase,b) ==
+      zero?(b) =>
+        messagePrint("discreteLog: logarithm of zero")$OutputForm
+        "failed"
+      zero?(logbase) =>
+        messagePrint("discreteLog: logarithm to base zero")$OutputForm
+        "failed"
+      b = logbase => 1
+      not zero?((groupord:=order(logbase)@PI) rem order(b)@PI) =>
+         messagePrint("discreteLog: second argument not in cyclic group_
+ generated by first argument")$OutputForm
+         "failed"
+      faclist:=factors factor groupord
+      a:=b
+      disclog:Integer:=0
+      mult:Integer:=1
+      exp:Integer:= groupord
+      for f in faclist repeat
+        fac:=f.factor
+        primroot:= logbase ** (groupord quo fac)
+        for t in 0..f.exponent-1 repeat
+          exp:=exp quo fac
+          rhoHelp:= shanksDiscLogAlgorithm(primroot,_
+                a**exp,fac pretend NonNegativeInteger)$DLP($)
+          rhoHelp case "failed" => return "failed"
+          rho := (rhoHelp :: NNI) * mult
+          disclog := disclog + rho
+          mult := mult * fac
+          a:=a * (logbase ** (-rho))
+      disclog pretend NonNegativeInteger
+
+    FP ==> SparseUnivariatePolynomial($)
+    FRP ==> Factored FP
+    f,g:FP
+
+-- TPDHERE: why is this here? It isn't exported.
     squareFreePolynomial(f:FP):FRP ==
           squareFree(f)$UnivariatePolynomialSquareFree($,FP)
 
+-- TPDHERE: why is this here? It isn't exported.
     factorPolynomial(f:FP):FRP == factor(f)$DistinctDegreeFactorize($,FP)
 
+-- TPDHERE: why is this here? It isn't exported.
     factorSquareFreePolynomial(f:FP):FRP ==
         f = 0 => 0
         flist := distdfact(f,true)$DistinctDegreeFactorize($,FP)
         (flist.cont :: FP) *
             (*/[primeFactor(u.irr,u.pow) for u in flist.factors])
 
+    gcdPolynomial : (SparseUnivariatePolynomial(%),
+                     SparseUnivariatePolynomial(%)) ->
+                        SparseUnivariatePolynomial(%)
     gcdPolynomial(f:FP,g:FP):FP ==
          gcd(f,g)$EuclideanDomain_&(FP)
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{FFIELDC.dotabb}
 "FFIELDC"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FFIELDC"];
@@ -71800,6 +83192,7 @@ FiniteFieldCategory() : Category ==_
 "FFIELDC" -> "DIFRING"
 
 \end{chunk}
+
 \begin{chunk}{FFIELDC.dotfull}
 "FiniteFieldCategory()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FFIELDC"];
@@ -71809,6 +83202,7 @@ FiniteFieldCategory() : Category ==_
 "FiniteFieldCategory()" -> "DifferentialRing()"
 
 \end{chunk}
+
 \begin{chunk}{FFIELDC.dotpic}
 digraph pic {
  fontsize=10;
@@ -71842,6 +83236,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FloatingPointSystem}{FPS}
 \pagepic{ps/v102floatingpointsystem.ps}{FPS}{0.50}
@@ -71933,6 +83328,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FloatingPointSystem.help}
 ====================================================================
 FloatingPointSystem examples
@@ -72289,18 +83685,35 @@ FloatingPointSystem(): Category == RealNumberSystem() with
    digits() == max(1,4004 * (bits()-1) quo 13301)::PositiveInteger
 
 \end{chunk}
+
+\begin{chunk}{COQ FPS}
+(* category FPS *)
+(*
+
+   float : (Integer,Integer) -> %
+   float(ma, ex) == float(ma, ex, base())
+
+   digits : () -> PositiveInteger
+   digits() == max(1,4004 * (bits()-1) quo 13301)::PositiveInteger
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FPS.dotabb}
 "FPS"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FPS"];
 "FPS" -> "RNS"
 
 \end{chunk}
+
 \begin{chunk}{FPS.dotfull}
 "FloatingPointSystem()"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FPS"];
 "FloatingPointSystem()" -> "RealNumberSystem()"
 
 \end{chunk}
+
 \begin{chunk}{FPS.dotpic}
 digraph pic {
  fontsize=10;
@@ -72331,6 +83744,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FramedAlgebra}{FRAMALG}
 \pagepic{ps/v102framedalgebra.ps}{FRAMALG}{0.50}
@@ -72388,6 +83802,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FramedAlgebra.help}
 ====================================================================
 FramedAlgebra examples
@@ -72596,12 +84011,79 @@ FramedAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R):
         +/[monomial(v.(i+1),i) for i in 0..#v-1]
 
 \end{chunk}
+
+\begin{chunk}{COQ FRAMALG}
+(* category FRAMALG *)
+(*
+
+   convert : % -> Vector(R)
+   convert(x:%):Vector(R) == coordinates(x)
+
+   convert : Vector(R) -> %
+   convert(v:Vector R):% == represents(v)
+
+   traceMatrix : () -> Matrix(R)
+   traceMatrix() == traceMatrix basis()
+
+   discriminant : () -> R
+   discriminant() == discriminant basis()
+
+   regularRepresentation : % -> Matrix(R)
+   regularRepresentation x == regularRepresentation(x, basis())
+
+   coordinates : % -> Vector(R)
+   coordinates x == coordinates(x, basis())
+
+   represents : Vector(R) -> %
+   represents x == represents(x, basis())
+
+   coordinates : Vector(%) -> Matrix(R)
+   coordinates(v:Vector %) ==
+     m := new(#v, rank(), 0)$Matrix(R)
+     for i in minIndex v .. maxIndex v for j in minRowIndex m .. repeat
+       setRow_!(m, j, coordinates qelt(v, i))
+     m
+
+   regularRepresentation : % -> Matrix(R)
+   regularRepresentation x ==
+     m := new(n := rank(), n, 0)$Matrix(R)
+     b := basis()
+     for i in minIndex b .. maxIndex b for j in minRowIndex m .. repeat
+       setRow_!(m, j, coordinates(x * qelt(b, i)))
+     m
+
+   characteristicPolynomial : % -> UP
+   characteristicPolynomial x ==
+      mat00 := (regularRepresentation x)
+      mat0 := map(y+->y::UP,mat00)$MatrixCategoryFunctions2(R, Vector R,
+                  Vector R, Matrix R, UP, Vector UP,Vector UP, Matrix UP)
+      mat1 : Matrix UP := scalarMatrix(rank(),monomial(1,1)$UP)
+      determinant(mat1 - mat0)
+
+   if R has Field then
+    -- depends on the ordering of results from nullSpace, also see FFP
+
+      minimalPolynomial : % -> UP
+      minimalPolynomial(x:%):UP ==
+        y:%:=1
+        n:=rank()
+        m:Matrix R:=zero(n,n+1)
+        for i in 1..n+1 repeat
+          setColumn_!(m,i,coordinates(y))
+          y:=y*x
+        v:=first nullSpace(m)
+        +/[monomial(v.(i+1),i) for i in 0..#v-1]
+*)
+
+\end{chunk}
+
 \begin{chunk}{FRAMALG.dotabb}
 "FRAMALG"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FRAMALG"];
 "FRAMALG" -> "FINRALG"
 
 \end{chunk}
+
 \begin{chunk}{FRAMALG.dotfull}
 "FramedAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FRAMALG"];
@@ -72609,6 +84091,7 @@ FramedAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R):
    "FiniteRankAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))"
 
 \end{chunk}
+
 \begin{chunk}{FRAMALG.dotpic}
 digraph pic {
  fontsize=10;
@@ -72654,6 +84137,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PseudoAlgebraicClosureOfFiniteFieldCategory}{PACFFC}
 \pagepic{ps/v102pseudoalgebraicclosureoffinitefieldcategory.ps}{PACFFC}{0.50}
@@ -72747,6 +84231,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PseudoAlgebraicClosureOfFiniteFieldCategory.help}
 ====================================================================
 PseudoAlgebraicClosureOfFiniteFieldCategory examples
@@ -73017,11 +84502,13 @@ PseudoAlgebraicClosureOfFiniteFieldCategory:Category ==
   Join(FiniteFieldCategory, PseudoAlgebraicClosureOfPerfectFieldCategory)
 
 \end{chunk}
+
 \begin{chunk}{PACFFC.dotabb}
 "PACFFC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACFFC"];
 "PACFFC" -> "PACPERC"
 
 \end{chunk}
+
 \begin{chunk}{PACFFC.dotfull}
 "PseudoAlgebraicClosureOfFiniteFieldCategory"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PACFFC"];
@@ -73031,6 +84518,7 @@ PseudoAlgebraicClosureOfFiniteFieldCategory:Category ==
   "FiniteFieldCategory()"
 
 \end{chunk}
+
 \begin{chunk}{PACFFC.dotpic}
 digraph pic {
  fontsize=10;
@@ -73047,6 +84535,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{UnivariateLaurentSeriesConstructorCategory}{ULSCCAT}
 \pagepic{ps/v102univariatelaurentseriesconstructorcategory.ps}{ULSCCAT}{0.50}
@@ -73254,6 +84743,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{UnivariateLaurentSeriesConstructorCategory.help}
 ====================================================================
 UnivariateLaurentSeriesConstructorCategory examples
@@ -73851,12 +85341,31 @@ UnivariateLaurentSeriesConstructorCategory(Coef,UTS):_
     retractIfCan(x:%):Union(UTS,"failed") == taylorIfCan x
 
 \end{chunk}
+
+\begin{chunk}{COQ ULSCCAT}
+(* category ULSCCAT *)
+(*
+
+    zero? : % -> Boolean
+    zero? x == zero? taylorRep x
+
+    retract : % -> UTS
+    retract(x:%):UTS == taylor x
+
+    retractIfCan : % -> Union(Symbol,"failed")
+    retractIfCan(x:%):Union(UTS,"failed") == taylorIfCan x
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ULSCCAT.dotabb}
 "ULSCCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ULSCCAT"];
 "ULSCCAT" -> "ULSCAT"
 
 \end{chunk}
+
 \begin{chunk}{ULSCCAT.dotfull}
 "UnivariateLaurentSeriesConstructorCategory(a:Ring,b:UnivariateTaylorSeriesCategory(Ring))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=ULSCCAT"];
@@ -73864,6 +85373,7 @@ UnivariateLaurentSeriesConstructorCategory(Coef,UTS):_
   -> "UnivariateLaurentSeriesCategory(a:Ring)" 
 
 \end{chunk}
+
 \begin{chunk}{ULSCCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -73911,6 +85421,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{UnivariatePuiseuxSeriesConstructorCategory}{UPXSCCA}
 \pagepic{ps/v102univariatepuiseuxseriesconstructorcategory.ps}{UPXSCCA}{0.50}
@@ -74061,6 +85572,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{UnivariatePuiseuxSeriesConstructorCategory.help}
 ====================================================================
 UnivariatePuiseuxSeriesConstructorCategory examples
@@ -74462,6 +85974,24 @@ UnivariatePuiseuxSeriesConstructorCategory(Coef,ULS):_
      retractIfCan(x:%):Union(ULS,"failed") == laurentIfCan x
 
 \end{chunk}
+
+\begin{chunk}{COQ UPXSCCA}
+(* category UPXSCCA *)
+(*
+
+     zero? : % -> Boolean
+     zero? x == zero? laurentRep x
+
+     retract : % -> ULS
+     retract(x:%):ULS == laurent x
+
+     retractIfCan : % -> Union(ULS,"failed")
+     retractIfCan(x:%):Union(ULS,"failed") == laurentIfCan x
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{UPXSCCA.dotabb}
 "UPXSCCA"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=UPXSCCA"];
@@ -74469,6 +85999,7 @@ UnivariatePuiseuxSeriesConstructorCategory(Coef,ULS):_
 "UPXSCCA" -> "UPXSCAT"
 
 \end{chunk}
+
 \begin{chunk}{UPXSCCA.dotfull}
 "UnivariatePuiseuxSeriesConstructorCategory(a:Ring,b:UnivariateLaurentSeriesCategory(a))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=UPXSCCA"];
@@ -74478,6 +86009,7 @@ UnivariatePuiseuxSeriesConstructorCategory(Coef,ULS):_
   -> "UnivariatePuiseuxSeriesCategory(a:Ring)"
 
 \end{chunk}
+
 \begin{chunk}{UPXSCCA.dotpic}
 digraph pic {
  fontsize=10;
@@ -74528,6 +86060,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 \chapter{Category Layer 18}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FiniteAlgebraicExtensionField}{FAXF}
@@ -74645,6 +86178,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FiniteAlgebraicExtensionField.help}
 ====================================================================
 FiniteAlgebraicExtensionField examples
@@ -75150,18 +86684,167 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
 
     transcendent? a == false
 
--- This definition is a duplicate and has been removed
---    extensionDegree():OnePointCompletion(PositiveInteger) ==
---      (#basis()) :: PositiveInteger::OnePointCompletion(PositiveInteger)
-
     extensionDegree() == (#basis()) :: PositiveInteger
 
--- These definitions are duplicates and have been removed
---    degree(a):OnePointCompletion(PositiveInteger) ==
---      degree(a)@PI::OnePointCompletion(PositiveInteger)
+    trace a ==
+      b := basis()
+      abs : F := 0
+      for i in 1..#b repeat
+        abs := abs + coordinates(a*b.i).i
+      abs
+
+    norm a ==
+      b := basis()
+      m := new(#b,#b, 0)$Matrix(F)
+      for i in 1..#b repeat
+        setRow_!(m,i, coordinates(a*b.i))
+      determinant(m)
+
+    if F has Finite then
+      linearAssociatedExp(x,f) ==
+        erg:$:=0
+        y:=x
+        for i in 0..degree(f) repeat
+          erg:=erg + coefficient(f,i) * y
+          y:=Frobenius(y)
+        erg
+
+      linearAssociatedLog(b,x) ==
+        x=0 => 0
+        l:List List F:=[entries coordinates b]
+        a:$:=b
+        extdeg:NNI:=extensionDegree()@PI
+        for i in 2..extdeg repeat
+          a:=Frobenius(a)
+          l:=concat(l,entries coordinates a)$(List List F)
+        l:=concat(l,entries coordinates x)$(List List F)
+        m1:=rowEchelon transpose matrix(l)$(Matrix F)
+        v:=zero(extdeg)$(Vector F)
+        rown:I:=1
+        for i in 1..extdeg repeat
+          if qelt(m1,rown,i) = 1$F then
+            v.i:=qelt(m1,rown,extdeg+1)
+            rown:=rown+1
+        p:=+/[monomial(v.(i+1),i::NNI) for i in 0..(#v-1)]
+        p=0 =>
+         messagePrint("linearAssociatedLog: second argument not in_
+                       group generated by first argument")$OutputForm
+         "failed"
+        p
+
+      linearAssociatedLog(x) == linearAssociatedLog(normalElement(),x) ::
+                              SparseUnivariatePolynomial(F)
+
+      linearAssociatedOrder(x) ==
+        x=0 => 0
+        l:List List F:=[entries coordinates x]
+        a:$:=x
+        for i in 1..extensionDegree()@PI repeat
+          a:=Frobenius(a)
+          l:=concat(l,entries coordinates a)$(List List F)
+        v:=first nullSpace transpose matrix(l)$(Matrix F)
+        +/[monomial(v.(i+1),i::NNI) for i in 0..(#v-1)]
+
+      charthRoot(x):Union($,"failed") ==
+        (charthRoot(x)@$)::Union($,"failed")
+
+      minimalPolynomial(a,n) ==
+        extensionDegree()@PI rem n ^= 0 =>
+          error "minimalPolynomial: 2. argument must divide extension degree"
+        f:SUP $:=monomial(1,1)$(SUP $) - monomial(a,0)$(SUP $)
+        u:$:=Frobenius(a,n)
+        while not(u = a) repeat
+          f:=f * (monomial(1,1)$(SUP $) - monomial(u,0)$(SUP $))
+          u:=Frobenius(u,n)
+        f
+
+      norm(e,s) ==
+        qr := divide(extensionDegree(), s)
+        zero?(qr.remainder) =>
+          pow := (size()-1) quo (size()$F ** s - 1)
+          e ** (pow::NonNegativeInteger)
+        error "norm: second argument must divide degree of extension"
+
+      trace(e,s) ==
+        qr:=divide(extensionDegree(),s)
+        q:=size()$F
+        zero?(qr.remainder) =>
+          a:$:=0
+          for i in 0..qr.quotient-1 repeat
+            a:=a + e**(q**(s*i))
+          a
+        error "trace: second argument must divide degree of extension"
+
+      size() == size()$F ** extensionDegree()
+
+      createNormalElement() ==
+        characteristic() = size() => 1
+        res : $
+        for i in 1.. repeat
+          res := index(i :: PI)
+          not inGroundField? res =>
+            normal? res => return res
+        -- theorem: there exists a normal element, this theorem is
+        -- unknown to the compiler
+        res
+
+      normal?(x:$) ==
+        p:SUP $:=(monomial(1,extensionDegree()) - monomial(1,0))@(SUP $)
+        f:SUP $:= +/[monomial(Frobenius(x,i),i)$(SUP $) _
+                   for i in 0..extensionDegree()-1]
+        gcd(p,f) = 1 => true
+        false
+
+      degree a ==
+        y:$:=Frobenius a
+        deg:PI:=1
+        while y^=a repeat
+          y := Frobenius(y)
+          deg:=deg+1
+        deg
+
+\end{chunk}
+
+\begin{chunk}{COQ FAXF}
+(* category FAXF *)
+(*
+    I   ==> Integer
+    PI  ==> PositiveInteger
+    NNI ==> NonNegativeInteger
+    SUP ==> SparseUnivariatePolynomial
+    DLP ==> DiscreteLogarithmPackage
+
+    represents : Vector(F) -> %
+    represents(v) ==
+      a:$:=0
+      b:=basis()
+      for i in 1..extensionDegree()@PI repeat
+        a:=a+(v.i)*(b.i)
+      a
+
+    transcendenceDegree : () -> NonNegativeInteger
+    transcendenceDegree() == 0$NNI
+
+    dimension : () -> CardinalNumber
+    dimension() == (#basis()) ::NonNegativeInteger::CardinalNumber
+
+    coordinates : Vector(%) -> Matrix(F)
+    coordinates(v:Vector $) ==
+      m := new(#v, extensionDegree(), 0)$Matrix(F)
+      for i in minIndex v .. maxIndex v for j in minRowIndex m .. repeat
+        setRow_!(m, j, coordinates qelt(v, i))
+      m
+
+    algebraic? : % -> Boolean
+    algebraic? a == true
+
+    transcendent? : % -> Boolean
+    transcendent? a == false
 
-    -- degree a == degree(minimalPolynomial a)$SUP(F) :: PI
+    extensionDegree : () -> PositiveInteger
+    extensionDegree() == (#basis()) :: PositiveInteger
 
+    trace : % -> F
     trace a ==
       b := basis()
       abs : F := 0
@@ -75169,6 +86852,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
         abs := abs + coordinates(a*b.i).i
       abs
 
+    norm : % -> F
     norm a ==
       b := basis()
       m := new(#b,#b, 0)$Matrix(F)
@@ -75177,6 +86861,8 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
       determinant(m)
 
     if F has Finite then
+
+      linearAssociatedExp : (%,SparseUnivariatePolynomial(F)) -> %
       linearAssociatedExp(x,f) ==
         erg:$:=0
         y:=x
@@ -75185,6 +86871,8 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
           y:=Frobenius(y)
         erg
 
+      linearAssociatedLog : (%,%) ->
+         Union(SparseUnivariatePolynomial(F),"failed")
       linearAssociatedLog(b,x) ==
         x=0 => 0
         l:List List F:=[entries coordinates b]
@@ -75208,9 +86896,11 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
          "failed"
         p
 
+      linearAssociatedLog : % -> SparseUnivariatePolynomial(F)
       linearAssociatedLog(x) == linearAssociatedLog(normalElement(),x) ::
                               SparseUnivariatePolynomial(F)
 
+      linearAssociatedOrder : % -> SparseUnivariatePolynomial(F)
       linearAssociatedOrder(x) ==
         x=0 => 0
         l:List List F:=[entries coordinates x]
@@ -75221,11 +86911,13 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
         v:=first nullSpace transpose matrix(l)$(Matrix F)
         +/[monomial(v.(i+1),i::NNI) for i in 0..(#v-1)]
 
+      charthRoot : % -> Union(%,"failed")
       charthRoot(x):Union($,"failed") ==
         (charthRoot(x)@$)::Union($,"failed")
       -- norm(e) == norm(e,1) pretend F
       -- trace(e) == trace(e,1) pretend F
 
+      minimalPolynomial : (%,PositiveInteger) -> SparseUnivariatePolynomial(%)
       minimalPolynomial(a,n) ==
         extensionDegree()@PI rem n ^= 0 =>
           error "minimalPolynomial: 2. argument must divide extension degree"
@@ -75236,6 +86928,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
           u:=Frobenius(u,n)
         f
 
+      norm : (%,PositiveInteger) -> %
       norm(e,s) ==
         qr := divide(extensionDegree(), s)
         zero?(qr.remainder) =>
@@ -75243,6 +86936,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
           e ** (pow::NonNegativeInteger)
         error "norm: second argument must divide degree of extension"
 
+      trace : (%,PositiveInteger) -> %
       trace(e,s) ==
         qr:=divide(extensionDegree(),s)
         q:=size()$F
@@ -75253,8 +86947,10 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
           a
         error "trace: second argument must divide degree of extension"
 
+      size : () -> NonNegativeInteger
       size() == size()$F ** extensionDegree()
 
+      createNormalElement : () -> %
       createNormalElement() ==
         characteristic() = size() => 1
         res : $
@@ -75266,6 +86962,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
         -- unknown to the compiler
         res
 
+      normal? : % -> Boolean
       normal?(x:$) ==
         p:SUP $:=(monomial(1,extensionDegree()) - monomial(1,0))@(SUP $)
         f:SUP $:= +/[monomial(Frobenius(x,i),i)$(SUP $) _
@@ -75273,6 +86970,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
         gcd(p,f) = 1 => true
         false
 
+      degree : % -> PositiveInteger
       degree a ==
         y:$:=Frobenius a
         deg:PI:=1
@@ -75280,8 +86978,10 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
           y := Frobenius(y)
           deg:=deg+1
         deg
+*)
 
 \end{chunk}
+
 \begin{chunk}{FAXF.dotabb}
 "FAXF"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FAXF"];
@@ -75289,6 +86989,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
 "FAXF" -> "RETRACT"
 
 \end{chunk}
+
 \begin{chunk}{FAXF.dotfull}
 "FiniteAlgebraicExtensionField(a:Field)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FAXF"];
@@ -75296,6 +86997,7 @@ FiniteAlgebraicExtensionField(F : Field) : Category == _
 "FiniteAlgebraicExtensionField(a:Field)" -> "RetractableTo(a:Field)"
 
 \end{chunk}
+
 \begin{chunk}{FAXF.dotpic}
 digraph pic {
  fontsize=10;
@@ -75342,6 +87044,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{MonogenicAlgebra}{MONOGEN}
 \pagepic{ps/v102monogenicalgebra.ps}{MONOGEN}{0.40}
@@ -75478,6 +87181,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{MonogenicAlgebra.help}
 ====================================================================
 MonogenicAlgebra examples
@@ -75901,6 +87605,69 @@ MonogenicAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R):
        reduce(bc.coef1)
 
 \end{chunk}
+
+\begin{chunk}{COQ MONOGEN}
+(* category MONOGEN *)
+(*
+ 
+   convert : % -> UP
+   convert(x:%):UP == lift x
+
+   convert : UP -> %
+   convert(p:UP):% == reduce p
+
+   generator : () -> %
+   generator() == reduce monomial(1, 1)$UP
+
+   norm : % -> R
+   norm x == resultant(definingPolynomial(), lift x)
+
+   retract : % -> R
+   retract(x:%):R  == retract lift x
+
+   retractIfCan : % -> Union(R,"failed")
+   retractIfCan(x:%):Union(R, "failed") == retractIfCan lift x
+
+   basis : () -> Vector(%)
+   basis() ==
+     [reduce monomial(1,i)$UP for i in 0..(rank()-1)::NonNegativeInteger]
+
+   characteristicPolynomial : % -> UP
+   characteristicPolynomial(x:%):UP ==
+     characteristicPolynomial(x)$CharacteristicPolynomialInMonogenicalAlgebra(R,UP,%)
+
+   if R has Finite then
+
+     size : () -> NonNegativeInteger
+     size()   == size()$R ** rank()
+
+     random : () -> %
+     random() == represents [random()$R for i in 1..rank()]$Vector(R)
+
+   if R has Field then
+
+     reduce : UP -> %
+     reduce(x:Fraction UP) == reduce(numer x) exquo reduce(denom x)
+
+     differentiate : (%,(R -> R)) -> %
+     differentiate(x:%, d:R -> R) ==
+       p := definingPolynomial()
+       yprime := - reduce(map(d, p)) / reduce(differentiate p)
+       reduce(map(d, lift x)) + yprime * reduce differentiate lift x
+
+     derivationCoordinates : (Vector(%),(R -> R))
+     derivationCoordinates(b, d) ==
+       coordinates(map(x +-> differentiate(x, d), b), b)
+
+     recip : % -> Union(%,"failed")
+     recip x ==
+       (bc := extendedEuclidean(lift x, definingPolynomial(), 1))
+                                                case "failed" => "failed"
+       reduce(bc.coef1)
+*)
+
+\end{chunk}
+
 \begin{chunk}{MONOGEN.dotabb}
 "MONOGEN"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MONOGEN"];
@@ -75915,6 +87682,7 @@ MonogenicAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R):
 "MONOGEN" -> "FFIELDC"
 
 \end{chunk}
+
 \begin{chunk}{MONOGEN.dotfull}
 "MonogenicAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=MONOGEN"];
@@ -75935,6 +87703,7 @@ MonogenicAlgebra(R:CommutativeRing, UP:UnivariatePolynomialCategory R):
     "MonogenicAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))"
 
 \end{chunk}
+
 \begin{chunk}{MONOGEN.dotpic}
 digraph pic {
  fontsize=10;
@@ -76068,6 +87837,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PseudoAlgebraicClosureOfRationalNumberCategory.help}
 ====================================================================
 PseudoAlgebraicClosureOfRationalNumberCategory examples
@@ -76347,17 +88117,20 @@ PseudoAlgebraicClosureOfRationalNumberCategory:Category ==
          RetractableTo(Fraction(Integer)),ExtensionField(Fraction(Integer)))
 
 \end{chunk}
+
 \begin{chunk}{PACRATC.dotabb}
 "PACRATC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACRATC"];
 "PACRATC" -> "XF"
 
 \end{chunk}
+
 \begin{chunk}{PACRATC.dotfull}
 "PseudoAlgebraicClosureOfRationalNumberCategory"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PACRATC"];
 "PseudoAlgebraicClosureOfRationalNumberCategory" -> "ExtensionField(F:Field)"
 
 \end{chunk}
+
 \begin{chunk}{PACRATC.dotpic}
 digraph pic {
  fontsize=10;
@@ -76564,6 +88337,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{ComplexCategory.help}
 ====================================================================
 ComplexCategory examples
@@ -77159,9 +88933,7 @@ ComplexCategory(R:CommutativeRing): Category ==
          zero? i => re
          outi := "%i"::Symbol::OutputForm
          ip :=
---           one? i => outi
            (i = 1) => outi
---           one?(-i) => -outi
            ((-i) = 1) => -outi
            ie * outi
          zero? r => ip
@@ -77245,7 +89017,6 @@ ComplexCategory(R:CommutativeRing): Category ==
 
        if R has IntegralDomain then
          _exquo(x:%, r:R) ==
---           one? r => x
            (r = 1) => x
            (r1 := real(x) exquo r) case "failed" => "failed"
            (r2 := imag(x) exquo r) case "failed" => "failed"
@@ -77367,47 +89138,576 @@ ComplexCategory(R:CommutativeRing): Category ==
             stoc ==> S_-TO_-C$Lisp
             ctos ==> C_-TO_-S$Lisp
 
-            exp   x == ctos EXP(stoc x)$Lisp
-            log   x == ctos LOG(stoc x)$Lisp
+            exp   x == ctos EXP(stoc x)$Lisp
+            log   x == ctos LOG(stoc x)$Lisp
+
+            sin   x == ctos SIN(stoc x)$Lisp
+            cos   x == ctos COS(stoc x)$Lisp
+            tan   x == ctos TAN(stoc x)$Lisp
+            asin  x == ctos ASIN(stoc x)$Lisp
+            acos  x == ctos ACOS(stoc x)$Lisp
+            atan  x == ctos ATAN(stoc x)$Lisp
+
+            sinh  x == ctos SINH(stoc x)$Lisp
+            cosh  x == ctos COSH(stoc x)$Lisp
+            tanh  x == ctos TANH(stoc x)$Lisp
+            asinh x == ctos ASINH(stoc x)$Lisp
+            acosh x == ctos ACOSH(stoc x)$Lisp
+            atanh x == ctos ATANH(stoc x)$Lisp
+
+         else
+           atan x ==
+             ix := imaginary()*x
+             - imaginary() * half * (log(1 + ix) - log(1 - ix))
+
+           log x ==
+             complex(log(norm x) * half, argument x)
+
+           exp x ==
+             e := exp real x
+             complex(e * cos imag x, e * sin imag x)
+
+           cos x ==
+             e := exp(imaginary() * x)
+             half * (e + recip(e)::%)
+
+           sin x ==
+             e := exp(imaginary() * x)
+             - imaginary() * half * (e - recip(e)::%)
+
+         if R has RealNumberSystem then
+           polarCoordinates x ==
+             [sqrt norm x, (negative?(t := argument x) => t + 2 * pi(); t)]
+
+           x:% ** q:Fraction(Integer) ==
+             zero? q =>
+               zero? x => error "0 ** 0 is undefined"
+               1
+             zero? x => 0
+             rx := real x
+             zero? imag x and positive? rx => (rx ** q)::%
+             zero? imag x and denom q = 2 => complex(0, (-rx)**q)
+             ax := sqrt(norm x) ** q
+             tx := q::R * argument x
+             complex(ax * cos tx, ax * sin tx)
+
+         else if R has RadicalCategory then
+           x:% ** q:Fraction(Integer) ==
+             zero? q =>
+               zero? x => error "0 ** 0 is undefined"
+               1
+             r := real x
+             zero?(i := imag x) => (r ** q)::%
+             t := numer(q) * recip(denom(q)::R)::R * argument x
+             e:R :=
+               zero? r => i ** q
+               norm(x) ** (q / (2::Fraction(Integer)))
+             complex(e * cos t, e * sin t)
+
+\end{chunk}
+
+\begin{chunk}{COQ COMPCAT}
+(* category COMPCAT *)
+(*
+       import MatrixCategoryFunctions2(%, Vector %, Vector %, Matrix %,
+                                       R, Vector R, Vector R, Matrix R)
+
+       SUP ==> SparseUnivariatePolynomial
+
+       characteristicPolynomial : % -> SparseUnivariatePolynomial(R)
+       characteristicPolynomial x ==
+          v := monomial(1,1)$SUP(R)
+          v**2 - trace(x)*v**1 + norm(x)*v**0
+
+       if R has PolynomialFactorizationExplicit and R has EuclideanDomain then
+
+          SupR ==> SparseUnivariatePolynomial R
+
+          Sup ==> SparseUnivariatePolynomial %
+
+          import FactoredFunctionUtilities Sup
+          import UnivariatePolynomialCategoryFunctions2(R,SupR,%,Sup)
+          import UnivariatePolynomialCategoryFunctions2(%,Sup,R,SupR)
+
+          pp,qq:Sup
+
+          if R has IntegerNumberSystem then
+
+             myNextPrime: (%,NonNegativeInteger) -> %
+             myNextPrime(x,n ) == -- prime is actually in R, and = 3(mod 4)
+                xr:=real(x)-4::R
+                while not prime? xr repeat
+                   xr:=xr-4::R
+                complex(xr,0)
+             --!TT:=InnerModularGcd(%,Sup,32719 :: %,myNextPrime)
+             --!gcdPolynomial(pp,qq) == modularGcd(pp,qq)$TT
+
+             solveLinearPolynomialEquation :
+               (List(SparseUnivariatePolynomial(%)),
+                SparseUnivariatePolynomial(%)) ->
+                   Union(List(SparseUnivariatePolynomial(%)),"failed")
+             solveLinearPolynomialEquation(lp:List Sup,p:Sup) ==
+               solveLinearPolynomialEquation(lp,p)$ComplexIntegerSolveLinearPolynomialEquation(R,%)
+
+          normPolynomial: Sup -> SupR
+          normPolynomial pp ==
+              map(z+->retract(z@%)::R,pp * map(conjugate,pp))
+
+          factorPolynomial : SparseUnivariatePolynomial(%) ->
+             Factored(SparseUnivariatePolynomial(%))
+          factorPolynomial pp ==
+              refine(squareFree pp,factorSquareFreePolynomial)
+
+          factorSquareFreePolynomial : SparseUnivariatePolynomial(%) ->
+             Factored(SparseUnivariatePolynomial(%))
+          factorSquareFreePolynomial pp ==
+              pnorm:=normPolynomial pp
+              k:R:=0
+              while degree gcd(pnorm,differentiate pnorm)>0 repeat
+                 k:=k+1
+                 pnorm:=normPolynomial
+                          elt(pp,monomial(1,1)-monomial(complex(0,k),0))
+              fR:=factorSquareFreePolynomial pnorm
+              numberOfFactors fR = 1 =>
+                  makeFR(1,[["irred",pp,1]])
+              lF:List Record(flg:Union("nil", "sqfr", "irred", "prime"),
+                             fctr:Sup, xpnt:Integer):=[]
+              for u in factorList fR repeat
+                  p1:=map((z:R):%+->z::%,u.fctr)
+                  if not zero? k then
+                     p1:=elt(p1,monomial(1,1)+monomial(complex(0,k),0))
+                  p2:=gcd(p1,pp)
+                  lF:=cons(["irred",p2,1],lF)
+                  pp:=(pp exquo p2)::Sup
+              makeFR(pp,lF)
+
+       rank : () -> PositiveInteger
+       rank() == 2
+
+       discriminant : () -> R
+       discriminant() == -4 :: R
+
+       norm : % -> R
+       norm x == real(x)**2 + imag(x)**2
+
+       trace : % -> R
+       trace x == 2 * real x
+
+       imaginary : () -> %
+       imaginary() == complex(0, 1)
+
+       conjugate : % -> %
+       conjugate x == complex(real x, - imag x)
+
+       characteristic : () -> NonNegativeInteger
+       characteristic() == characteristic()$R
+
+       map : ((R -> R),%) -> %
+       map(fn, x) == complex(fn real x, fn imag x)
+
+       ?=? : (%,%) -> Boolean
+       x = y == real(x) = real(y) and imag(x) = imag(y)
+
+       ?+? : (%,%) -> %
+       x + y == complex(real x + real y, imag x + imag y)
+
+       -? : % -> %
+       - x == complex(- real x, - imag x)
+
+       ?*? : (R,%) -> %
+       r:R * x:% == complex(r * real x, r * imag x)
+
+       coordinates : % -> Vector(R)
+       coordinates(x:%) == [real x, imag x]
+
+       ?*? : (Integer,%) -> %
+       n:Integer * x:%  == complex(n * real x, n * imag x)
+
+       differentiate : (%,(R -> R)) -> %
+       differentiate(x:%, d:R -> R) == complex(d real x, d imag x)
+
+       definingPolynomial : () -> SparseUnivariatePolynomial(R)
+       definingPolynomial() ==
+         monomial(1,2)$(SUP R) + monomial(1,0)$(SUP R)
+
+       reduce : SparseUnivariatePolynomial(R) -> %
+       reduce(pol:SUP R) ==
+         part:= (monicDivide(pol,definingPolynomial())).remainder
+         complex(coefficient(part,0),coefficient(part,1))
+
+       lift : % -> SparseUnivariatePolynomial(R)
+       lift(x) == monomial(real x,0)$(SUP R)+monomial(imag x,1)$(SUP R)
+
+       minimalPolynomial : % -> SparseUnivariatePolynomial(R)
+       minimalPolynomial x ==
+         zero? imag x =>
+           monomial(1, 1)$(SUP R) - monomial(real x, 0)$(SUP R)
+         monomial(1, 2)$(SUP R) - monomial(trace x, 1)$(SUP R)
+           + monomial(norm x, 0)$(SUP R)
+
+       coordinates : (%,Vector(%)) -> Vector(R)
+       coordinates(x:%, v:Vector %):Vector(R) ==
+         ra := real(a := v(minIndex v))
+         rb := real(b := v(maxIndex v))
+         (#v ^= 2) or
+           ((d := recip(ra * (ib := imag b) - (ia := imag a) * rb))
+             case "failed") =>error "coordinates: vector is not a basis"
+         rx := real x
+         ix := imag x
+         [d::R * (rx * ib - ix * rb), d::R * (ra * ix - ia * rx)]
+
+       coerce : % -> OutputForm
+       coerce(x:%):OutputForm ==
+         re := (r := real x)::OutputForm
+         ie := (i := imag x)::OutputForm
+         zero? i => re
+         outi := "%i"::Symbol::OutputForm
+         ip :=
+           (i = 1) => outi
+           ((-i) = 1) => -outi
+           ie * outi
+         zero? r => ip
+         re + ip
+
+       retract : % -> R
+       retract(x:%):R ==
+         not zero?(imag x) =>
+           error "Imaginary part is nonzero. Cannot retract."
+         real x
+
+       retractIfCan : % -> Union(R,"failed")
+       retractIfCan(x:%):Union(R, "failed") ==
+         not zero?(imag x) => "failed"
+         real x
+
+       ?*? : (%,%) -> %
+       x:% * y:% ==
+         complex(real x * real y - imag x * imag y,
+                  imag x * real y + imag y * real x)
+
+       reducedSystem : Matrix(%) -> Matrix(R)
+       reducedSystem(m:Matrix %):Matrix R ==
+         vertConcat(map(real, m), map(imag, m))
+
+       reducedSystem : (Matrix(%),Vector(%)) ->
+          Record(mat: Matrix(R),vec: Vector(R))
+       reducedSystem(m:Matrix %, v:Vector %):
+        Record(mat:Matrix R, vec:Vector R) ==
+         rh := reducedSystem(v::Matrix %)@Matrix(R)
+         [reducedSystem(m)@Matrix(R), column(rh, minColIndex rh)]
+
+       if R has RealNumberSystem then
+
+         abs : % -> %
+         abs(x:%):%        == (sqrt norm x)::%
+
+       if R has RealConstant then
+
+         convert : % -> Complex(DoubleFloat)
+         convert(x:%):Complex(DoubleFloat) ==
+          complex(convert(real x)@DoubleFloat,convert(imag x)@DoubleFloat)
+
+         convert : % -> Complex(Float)
+         convert(x:%):Complex(Float) ==
+           complex(convert(real x)@Float, convert(imag x)@Float)
+
+       if R has ConvertibleTo InputForm then
+
+         convert : % -> InputForm
+         convert(x:%):InputForm ==
+           convert([convert("complex"::Symbol), convert real x,
+                    convert imag x]$List(InputForm))@InputForm
+
+       if R has ConvertibleTo Pattern Integer then
+
+         convert : % -> Pattern(Integer)
+         convert(x:%):Pattern Integer ==
+            convert(x)$ComplexPattern(Integer, R, %)
+
+       if R has ConvertibleTo Pattern Float then
+
+         convert : % -> Pattern(Float)
+         convert(x:%):Pattern Float ==
+            convert(x)$ComplexPattern(Float, R, %)
+
+       if R has PatternMatchable Integer then
+
+         patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) ->
+            PatternMatchResult(Integer,%)
+         patternMatch(x:%, p:Pattern Integer,
+          l:PatternMatchResult(Integer, %)) ==
+           patternMatch(x, p, l)$ComplexPatternMatch(Integer, R, %)
+
+       if R has PatternMatchable Float then
+
+         patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) ->
+            PatternMatchResult(Float,%)
+         patternMatch(x:%, p:Pattern Float,
+          l:PatternMatchResult(Float, %)) ==
+           patternMatch(x, p, l)$ComplexPatternMatch(Float, R, %)
+
+
+       if R has OrderedSet then
+
+         ?<? : (%,%) -> Boolean
+         x < y ==
+           real x = real y => imag x < imag y
+           real x < real y
+
+       if R has IntegerNumberSystem then
+
+         rational? : % -> Boolean
+         rational? x == zero? imag x
+
+         rational : % -> Fraction(Integer)
+         rational x ==
+           zero? imag x => rational real x
+           error "Not a rational number"
+
+         rationalIfCan : % -> Union(Fraction(Integer),"failed")
+         rationalIfCan x ==
+           zero? imag x => rational real x
+           "failed"
+
+       if R has Field then
+
+         inv : % -> %
+         inv x ==
+           zero? imag x => (inv real x)::%
+           r := norm x
+           complex(real(x) / r, - imag(x) / r)
+
+       if R has IntegralDomain then
+
+         exquo : (%,R) -> Union(%,"failed")
+         _exquo(x:%, r:R) ==
+           (r = 1) => x
+           (r1 := real(x) exquo r) case "failed" => "failed"
+           (r2 := imag(x) exquo r) case "failed" => "failed"
+           complex(r1, r2)
+
+         exquo : (%,%) -> Union(%,"failed")
+         _exquo(x:%, y:%) ==
+           zero? imag y => x exquo real y
+           x * conjugate(y) exquo norm(y)
+
+         recip : % -> Union(%,"failed")
+         recip(x:%) == 1 exquo x
+
+         if R has OrderedRing then
+
+           unitNormal : % -> Record(unit: %,canonical: %,associate: %)
+           unitNormal x ==
+             zero? x => [1,x,1]
+             (u := recip x) case % => [x, 1, u]
+             zero? real x =>
+               c := unitNormal imag x
+               [complex(0, c.unit), (c.associate * imag x)::%,
+                                              complex(0, - c.associate)]
+             c := unitNormal real x
+             x := c.associate * x
+             imag x < 0 =>
+               x := complex(- imag x, real x)
+               [- c.unit * imaginary(), x, c.associate * imaginary()]
+             [c.unit ::%, x, c.associate ::%]
+
+         else
+
+           unitNormal : % -> Record(unit: %,canonical: %,associate: %)
+           unitNormal x ==
+             zero? x => [1,x,1]
+             (u := recip x) case % => [x, 1, u]
+             zero? real x =>
+               c := unitNormal imag x
+               [complex(0, c.unit), (c.associate * imag x)::%,
+                                              complex(0, - c.associate)]
+             c := unitNormal real x
+             x := c.associate * x
+             [c.unit ::%, x, c.associate ::%]
+
+       if R has EuclideanDomain then
+
+          if R has additiveValuation then
+
+              euclideanSize : % -> NonNegativeInteger
+              euclideanSize x == max(euclideanSize real x,
+                                     euclideanSize imag x)
+
+          else
+
+              euclideanSize : % -> NonNegativeInteger
+              euclideanSize x == euclideanSize(real(x)**2 + imag(x)**2)$R
+
+          if R has IntegerNumberSystem then
+
+            ?rem? : (%,%) -> % if R has EUCDOM
+            x rem y ==
+              zero? imag y =>
+                yr:=real y
+                complex(symmetricRemainder(real(x), yr),
+                        symmetricRemainder(imag(x), yr))
+              divide(x, y).remainder
+
+            ?quo? : (%,%) -> % if R has EUCDOM
+            x quo y ==
+              zero? imag y =>
+                yr:= real y
+                xr:= real x
+                xi:= imag x
+                complex((xr-symmetricRemainder(xr,yr)) quo yr,
+                        (xi-symmetricRemainder(xi,yr)) quo yr)
+              divide(x, y).quotient
+
+          else
+
+            ?rem? : (%,%) -> % if R has EUCDOM
+            x rem y ==
+              zero? imag y =>
+                yr:=real y
+                complex(real(x) rem yr,imag(x) rem yr)
+              divide(x, y).remainder
+
+            ?quo? : (%,%) -> % if R has EUCDOM
+            x quo y ==
+              zero? imag y => complex(real x quo real y,imag x quo real y)
+              divide(x, y).quotient
+
+          divide : (%,%) -> Record(quotient: %,remainder: %)
+          divide(x, y) ==
+            r := norm y
+            y1 := conjugate y
+            xx := x * y1
+            x1 := real(xx) rem r
+            a  := x1
+            if x1^=0 and sizeLess?(r, 2 * x1) then
+              a := x1 - r
+              if sizeLess?(x1, a) then a := x1 + r
+            x2 := imag(xx) rem r
+            b  := x2
+            if x2^=0 and sizeLess?(r, 2 * x2) then
+              b := x2 - r
+              if sizeLess?(x2, b) then b := x2 + r
+            y1 := (complex(a, b) exquo y1)::%
+            [((x - y1) exquo y)::%, y1]
+
+       if R has TranscendentalFunctionCategory then
+
+         half := recip(2::R)::R
+
+         if R has RealNumberSystem then
+
+           atan2loc : R -> R
+           atan2loc(y: R, x: R): R ==
+               pi1 := pi()$R
+               pi2 := pi1 * half
+               x = 0 => if y >= 0 then pi2 else -pi2
+
+               -- Atan in (-pi/2,pi/2]
+               theta := atan(y * recip(x)::R)
+               while theta <= -pi2 repeat theta := theta + pi1
+               while theta >   pi2 repeat theta := theta - pi1
+
+               x >= 0 => theta      -- I or IV
+
+               if y >= 0 then
+                   theta + pi1      -- II
+               else
+                   theta - pi1      -- III
+
+           argument : % -> R
+           argument x == atan2loc(imag x, real x)
+
+         else
+
+           -- Not ordered so dictate two quadrants
+           argument : % -> R
+           argument x ==
+             zero? real x => pi()$R * half
+             atan(imag(x) * recip(real x)::R)
+
+         pi : () -> %
+         pi()  == pi()$R :: %
+
+         if R is DoubleFloat then
+
+            stoc ==> S_-TO_-C$Lisp
+            ctos ==> C_-TO_-S$Lisp
+
+            exp : % -> %
+            exp x == ctos EXP(stoc x)$Lisp
 
-            sin   x == ctos SIN(stoc x)$Lisp
-            cos   x == ctos COS(stoc x)$Lisp
-            tan   x == ctos TAN(stoc x)$Lisp
-            asin  x == ctos ASIN(stoc x)$Lisp
-            acos  x == ctos ACOS(stoc x)$Lisp
-            atan  x == ctos ATAN(stoc x)$Lisp
+            log : % -> %
+            log x == ctos LOG(stoc x)$Lisp
 
-            sinh  x == ctos SINH(stoc x)$Lisp
-            cosh  x == ctos COSH(stoc x)$Lisp
-            tanh  x == ctos TANH(stoc x)$Lisp
+            sin : % -> %
+            sin x == ctos SIN(stoc x)$Lisp
+
+            cos : % -> %
+            cos x == ctos COS(stoc x)$Lisp
+
+            tan : % -> %
+            tan x == ctos TAN(stoc x)$Lisp
+
+            asin : % -> %
+            asin x == ctos ASIN(stoc x)$Lisp
+
+            acos : % -> %
+            acos x == ctos ACOS(stoc x)$Lisp
+
+            atan : % -> %
+            atan x == ctos ATAN(stoc x)$Lisp
+
+            sinh : % -> %
+            sinh x == ctos SINH(stoc x)$Lisp
+
+            cosh : % -> %
+            cosh x == ctos COSH(stoc x)$Lisp
+
+            tanh : % -> %
+            tanh x == ctos TANH(stoc x)$Lisp
+
+            asinh : % -> %
             asinh x == ctos ASINH(stoc x)$Lisp
+
+            acosh : % -> %
             acosh x == ctos ACOSH(stoc x)$Lisp
+
+            atanh : % -> %
             atanh x == ctos ATANH(stoc x)$Lisp
 
          else
+
+           atan : % -> %
            atan x ==
              ix := imaginary()*x
              - imaginary() * half * (log(1 + ix) - log(1 - ix))
 
+           log : % -> %
            log x ==
              complex(log(norm x) * half, argument x)
 
+           exp : % -> %
            exp x ==
              e := exp real x
              complex(e * cos imag x, e * sin imag x)
 
+           cos : % -> %
            cos x ==
              e := exp(imaginary() * x)
              half * (e + recip(e)::%)
 
+           sin : % -> %
            sin x ==
              e := exp(imaginary() * x)
              - imaginary() * half * (e - recip(e)::%)
 
          if R has RealNumberSystem then
+
+           polarCoordinates : % -> Record(r: R,phi: R)
            polarCoordinates x ==
              [sqrt norm x, (negative?(t := argument x) => t + 2 * pi(); t)]
 
+           ?**? : (%,Fraction(Integer)) -> %
            x:% ** q:Fraction(Integer) ==
              zero? q =>
                zero? x => error "0 ** 0 is undefined"
@@ -77421,6 +89721,8 @@ ComplexCategory(R:CommutativeRing): Category ==
              complex(ax * cos tx, ax * sin tx)
 
          else if R has RadicalCategory then
+
+           ?**? : (%,Fraction(Integer)) -> %
            x:% ** q:Fraction(Integer) ==
              zero? q =>
                zero? x => error "0 ** 0 is undefined"
@@ -77432,8 +89734,10 @@ ComplexCategory(R:CommutativeRing): Category ==
                zero? r => i ** q
                norm(x) ** (q / (2::Fraction(Integer)))
              complex(e * cos t, e * sin t)
+*)
 
 \end{chunk}
+
 \begin{chunk}{COMPCAT.dotabb}
 "COMPCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=COMPCAT"];
@@ -77448,6 +89752,7 @@ ComplexCategory(R:CommutativeRing): Category ==
 "COMPCAT" -> "ORDSET"
 
 \end{chunk}
+
 \begin{chunk}{COMPCAT.dotfull}
 "ComplexCategory(R:CommutativeRing)"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=COMPCAT"];
@@ -77471,6 +89776,7 @@ ComplexCategory(R:CommutativeRing): Category ==
   "OrderedSet()"
 
 \end{chunk}
+
 \begin{chunk}{COMPCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -77500,6 +89806,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{FunctionFieldCategory}{FFCAT}
 \pagepic{ps/v102functionfieldcategory.ps}{FFCAT}{0.70}
@@ -77674,6 +89981,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{FunctionFieldCategory.help}
 ====================================================================
 FunctionFieldCategory examples
@@ -78467,7 +90775,6 @@ FunctionFieldCategory(F, UP, UPUP): Category == Definition where
     infOrder f             == (degree denom f)::Z - (degree numer f)::Z
     integral? f            == ground?(integralCoordinates(f).den)
     integral?(f:$, a:F)    == (integralCoordinates(f).den)(a) ^= 0
---    absolutelyIrreducible? == one? numberOfComponents()
     absolutelyIrreducible? == numberOfComponents() = 1
     yCoordinates f         == splitDenominator coordinates f
 
@@ -78657,12 +90964,246 @@ FunctionFieldCategory(F, UP, UPUP): Category == Definition where
       differentiate(f, x +-> differentiate(x, d)$RF)
 
 \end{chunk}
+
+\begin{chunk}{COQ FFCAT}
+(* category FFCAT *)
+(*
+    import InnerCommonDenominator(UP, RF, Vector UP, Vector RF)
+    import UnivariatePolynomialCommonDenominator(UP, RF, UPUP)
+
+    Q2RF : Q  -> RF
+    Q2RF q == numer(q)::UP / denom(q)::UP
+
+    infOrder: RF -> Z
+    infOrder f == (degree denom f)::Z - (degree numer f)::Z
+
+    integral? : % -> Boolean
+    integral? f == ground?(integralCoordinates(f).den)
+
+    integral? : (%,F) -> Boolean
+    integral?(f:$, a:F) == (integralCoordinates(f).den)(a) ^= 0
+
+    absolutelyIrreducible? : () -> Boolean
+    absolutelyIrreducible? == numberOfComponents() = 1
+
+    yCoordinates : % -> Record(num: Vector(UP),den: UP)
+    yCoordinates f == splitDenominator coordinates f
+
+    hyperelliptic : () -> Union(UP,"failed")
+    hyperelliptic() ==
+      degree(f := definingPolynomial()) ^= 2 => "failed"
+      (u:=retractIfCan(reductum f)@Union(RF,"failed"))
+        case "failed" => "failed"
+      (v:=retractIfCan(-(u::RF) / leadingCoefficient f)@Union(UP, "failed"))
+        case "failed" => "failed"
+      odd? degree(p := v::UP) => p
+      "failed"
+
+    algSplitSimple : (%,(UP -> UP)) ->
+       Record(num: %,den: UP,derivden: UP,gd: UP)
+    algSplitSimple(f, derivation) ==
+      cd := splitDenominator lift f
+      dd := (cd.den exquo (g := gcd(cd.den, derivation(cd.den))))::UP
+      [reduce(inv(g::RF) * cd.num), dd, derivation dd,
+                                    gcd(dd, retract(discriminant())@UP)]
+
+    elliptic : () -> Union(UP,"failed")
+    elliptic() ==
+      (u := hyperelliptic()) case "failed" => "failed"
+      degree(p := u::UP) = 3 => p
+      "failed"
+
+    rationalPoint? : (F,F) -> Boolean
+    rationalPoint?(x, y)   ==
+      zero?((definingPolynomial() (y::UP::RF)) (x::UP::RF))
+
+    if F has Field then
+      import PolyGroebner(F)
+      import MatrixCommonDenominator(UP, RF)
+
+      UP2P : (UP, P) -> P
+      UP2P(p, x) ==
+        (map((s:F):P +-> s::P, p)_
+          $UnivariatePolynomialCategoryFunctions2(F, UP,
+                                     P, SparseUnivariatePolynomial P)) x
+
+      UPUP2P: (UPUP, P, P) -> P
+      UPUP2P(p, x, y) ==
+        (map((s:RF):P +-> UP2P(retract(s)@UP, x),p)_
+          $UnivariatePolynomialCategoryFunctions2(RF, UPUP,
+                                     P, SparseUnivariatePolynomial P)) y
+
+      nonSingularModel : Symbol -> List(Polynomial(F))
+      nonSingularModel u ==
+        d    := commonDenominator(coordinates(w := integralBasis()))::RF
+        vars := [concat(string u, string i)::SY for i in 1..(n := #w)]
+        x    := "%%dummy1"::SY
+        y    := "%%dummy2"::SY
+        select_!(s+->zero?(degree(s, x)) and zero?(degree(s, y)),
+                 lexGroebner([v::P - UPUP2P(lift(d * w.i), x::P, y::P)
+                    for v in vars for i in 1..n], concat([x, y], vars)))
+
+    if F has Finite then
+
+      ispoint: (UPUP, F, F) -> List F
+      ispoint(p, x, y) ==
+        jhd:RF:=p(y::UP::RF)
+        zero?(jhd (x::UP::RF)) => [x, y]
+        empty()
+
+      rationalPoints : () -> List(List(F))
+      rationalPoints() ==
+        p := definingPolynomial()
+        concat [[pt for y in 1..size()$F | not empty?(pt :=
+          ispoint(p, index(x::PositiveInteger)$F,
+                     index(y::PositiveInteger)$F))]$List(List F)
+                                for x in 1..size()$F]$List(List(List F))
+
+    intvalue: (Vector UP, F, F) -> F
+    intvalue(v, x, y) ==
+      singular? x => error "Point is singular"
+      mini := minIndex(w := integralBasis())
+      rec := yCoordinates(+/[qelt(v, i)::RF * qelt(w, i)
+                           for i in mini .. maxIndex w])
+      n   := +/[(qelt(rec.num, i) x) *
+                (y ** ((i - mini)::NonNegativeInteger))
+                           for i in mini .. maxIndex w]
+      zero?(d := (rec.den) x) =>
+        zero? n => error "0/0 -- cannot compute value yet"
+        error "Shouldn't happen"
+      (n exquo d)::F
+
+    elt : (%,F,F) -> F
+    elt(f, x, y) ==
+      rec := integralCoordinates f
+      n   := intvalue(rec.num, x, y)
+      zero?(d := (rec.den) x) =>
+        zero? n => error "0/0 -- cannot compute value yet"
+        error "Function has a pole at the given point"
+      (n exquo d)::F
+
+    primitivePart : % -> %
+    primitivePart f ==
+      cd := yCoordinates f
+      d  := gcd([content qelt(cd.num, i)
+                 for i in minIndex(cd.num) .. maxIndex(cd.num)]$List(F))
+                   * primitivePart(cd.den)
+      represents [qelt(cd.num, i) / d
+               for i in minIndex(cd.num) .. maxIndex(cd.num)]$Vector(RF)
+
+    reduceBasisAtInfinity : Vector(%) -> Vector(%)
+    reduceBasisAtInfinity b ==
+      x := monomial(1, 1)$UP ::RF
+      concat([[f for j in 0.. while
+                integralAtInfinity?(f := x**j * qelt(b, i))]$Vector($)
+                      for i in minIndex b .. maxIndex b]$List(Vector $))
+
+    complementaryBasis : Vector(%) -> Vector(%)
+    complementaryBasis b ==
+      m := inverse(traceMatrix b)::Matrix(RF)
+      [represents row(m, i) for i in minRowIndex m .. maxRowIndex m]
+
+    integralAtInfinity? : % -> Boolean
+    integralAtInfinity? f ==
+      not any?(s +-> infOrder(s) < 0,
+         coordinates(f) * inverseIntegralMatrixAtInfinity())$Vector(RF)
+
+    numberOfComponents : () -> NonNegativeInteger
+    numberOfComponents() ==
+      count(integralAtInfinity?, integralBasis())$Vector($)
+
+    represents : (Vector(UP),UP) -> %
+    represents(v:Vector UP, d:UP) ==
+      represents
+        [qelt(v, i) / d for i in minIndex v .. maxIndex v]$Vector(RF)
+
+    genus : () -> NonNegativeInteger
+    genus() ==
+      ds := discriminant()
+      d  := degree(retract(ds)@UP) + infOrder(ds * determinant(
+             integralMatrixAtInfinity() * inverseIntegralMatrix()) ** 2)
+      dd := (((d exquo 2)::Z - rank()) exquo numberOfComponents())::Z
+      (dd + 1)::NonNegativeInteger
+
+    repOrder: (Matrix RF, Z) -> Z
+    repOrder(m, i) ==
+      nostart:Boolean := true
+      ans:Z := 0
+      r := row(m, i)
+      for j in minIndex r .. maxIndex r | qelt(r, j) ^= 0 repeat
+        ans :=
+          nostart => (nostart := false; infOrder qelt(r, j))
+          min(ans, infOrder qelt(r,j))
+      nostart => error "Null row"
+      ans
+
+    infValue: RF -> Fraction F
+    infValue f ==
+      zero? f => 0
+      (n := infOrder f) > 0 => 0
+      zero? n =>
+        (leadingCoefficient numer f) / (leadingCoefficient denom f)
+      error "f not locally integral at infinity"
+
+    rfmonom : Z  -> RF
+    rfmonom n ==
+      n < 0 => inv(monomial(1, (-n)::NonNegativeInteger)$UP :: RF)
+      monomial(1, n::NonNegativeInteger)$UP :: RF
+
+    kmin : (Matrix RF,Vector Q) -> Union(Record(pos:Z,km:Z),"failed")
+    kmin(m, v) ==
+      nostart:Boolean := true
+      k:Z := 0
+      ii  := minRowIndex m - (i0  := minIndex v)
+      for i in minIndex v .. maxIndex v | qelt(v, i) ^= 0 repeat
+        nk := repOrder(m, i + ii)
+        if nostart then (nostart := false; k := nk; i0 := i)
+        else
+          if nk < k then (k := nk; i0 := i)
+      nostart => "failed"
+      [i0, k]
+
+    normalizeAtInfinity : Vector(%) -> Vector(%)
+    normalizeAtInfinity w ==
+      ans   := copy w
+      infm  := inverseIntegralMatrixAtInfinity()
+      mhat  := zero(rank(), rank())$Matrix(RF)
+      ii    := minIndex w - minRowIndex mhat
+      repeat
+        m := coordinates(ans) * infm
+        r := [rfmonom repOrder(m, i)
+                     for i in minRowIndex m .. maxRowIndex m]$Vector(RF)
+        for i in minRowIndex m .. maxRowIndex m repeat
+          for j in minColIndex m .. maxColIndex m repeat
+            qsetelt_!(mhat, i, j, qelt(r, i + ii) * qelt(m, i, j))
+        sol := first nullSpace transpose map(infValue,
+                mhat)$MatrixCategoryFunctions2(RF, Vector RF, Vector RF,
+                             Matrix RF, Q, Vector Q, Vector Q, Matrix Q)
+        (pr := kmin(m, sol)) case "failed" => return ans
+        qsetelt_!(ans, pr.pos,
+         +/[Q2RF(qelt(sol, i)) * rfmonom(repOrder(m, i - ii) - pr.km)
+                  * qelt(ans, i) for i in minIndex sol .. maxIndex sol])
+
+    integral? : (%,UP) -> Boolean
+    integral?(f:$, p:UP) ==
+      (r:=retractIfCan(p)@Union(F,"failed")) case F => integral?(f,r::F)
+      (integralCoordinates(f).den exquo p) case "failed"
+
+    differentiate : (%,(UP -> UP)) -> %
+    differentiate(f:$, d:UP -> UP) ==
+      differentiate(f, x +-> differentiate(x, d)$RF)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{FFCAT.dotabb}
 "FFCAT"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FFCAT"];
 "FFCAT" -> "MONOGEN"
 
 \end{chunk}
+
 \begin{chunk}{FFCAT.dotfull}
 "FunctionFieldCategory(a:UFD,b:UPOLYC(a),c:UPOLYC(Fraction(b)))"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=FFCAT"];
@@ -78670,6 +91211,7 @@ FunctionFieldCategory(F, UP, UPUP): Category == Definition where
    -> "MonogenicAlgebra(a:FRAC(UPOLYC(UFD)),b:UPOLYC(FRAC(UPOLYC(UFD))))"
 
 \end{chunk}
+
 \begin{chunk}{FFCAT.dotpic}
 digraph pic {
  fontsize=10;
@@ -78707,6 +91249,7 @@ digraph pic {
 }
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \pagehead{PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory}{PACEXTC}
 \pagepic{ps/v102pseudoalgebraicclosureofalgextofrationalnumbercategory.ps}{PACEXTC}{0.50}
@@ -78810,6 +91353,7 @@ digraph pic {
 )spool
 )lisp (bye)
 \end{chunk}
+
 \begin{chunk}{PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory.help}
 ====================================================================
 PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory examples
@@ -79101,6 +91645,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory:Category == Impl where
     Join(PseudoAlgebraicClosureOfRationalNumberCategory,_
          RetractableTo(Q),ExtensionField(Q))
 \end{chunk}
+
 \begin{chunk}{PACEXTC.dotabb}
 "PACEXTC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACEXTC"];
 "PACEXTC" -> "PACRATC"
@@ -79108,6 +91653,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory:Category == Impl where
 "PACEXTC" -> "XF"
 
 \end{chunk}
+
 \begin{chunk}{PACEXTC.dotfull}
 "PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory"
  [color=lightblue,href="bookvol10.2.pdf#nameddest=PACEXTC"];
@@ -79136,6 +91682,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumberCategory:Category == Impl where
   [color=lightblue,href="bookvol10.2.pdf#nameddest=XF"];
 
 \end{chunk}
+
 \begin{chunk}{PACEXTC.dotpic}
 digraph pic {
  fontsize=10;
@@ -93136,6 +105683,143 @@ Note that this code is not included in the generated catdef.spad file.
        0 26 2 0 19 0 0 47 1 0 29 0 34))))))
   (QUOTE |lookupComplete|))) 
 \end{chunk}
+
+\chapter{The Proofs}
+\begin{chunk}{coq}
+Module Categories
+\getchunk{COQ BASTYPE}
+\getchunk{COQ ELEMFUN}
+\getchunk{COQ HYPCAT}
+\getchunk{COQ IEVALAB}
+\getchunk{COQ ATJACID}
+\getchunk{COQ ATLUNIT}
+\getchunk{COQ ATMULVA}
+\getchunk{COQ ATNZDIV}
+\getchunk{COQ ATNULSQ}
+\getchunk{COQ ATPOSET}
+\getchunk{COQ RADCAT}
+\getchunk{COQ RETRACT}
+\getchunk{COQ ATRUNIT}
+\getchunk{COQ TRIGCAT}
+\getchunk{COQ AGG}
+\getchunk{COQ ELTAGG}
+\getchunk{COQ EVALAB}
+\getchunk{COQ FRETRCT}
+\getchunk{COQ LOGIC}
+\getchunk{COQ SETCAT}
+\getchunk{COQ TRANFUN}
+\getchunk{COQ ABELSG}
+\getchunk{COQ FINITE}
+\getchunk{COQ GRMOD}
+\getchunk{COQ HOAGG}
+\getchunk{COQ MONAD}
+\getchunk{COQ ORDSET}
+\getchunk{COQ RRCC}
+\getchunk{COQ SGROUP}
+\getchunk{COQ ABELMON}
+\getchunk{COQ BGAGG}
+\getchunk{COQ CLAGG}
+\getchunk{COQ DVARCAT}
+\getchunk{COQ ES}
+\getchunk{COQ GRALG}
+\getchunk{COQ IXAGG}
+\getchunk{COQ MONADWU}
+\getchunk{COQ MONOID}
+\getchunk{COQ RCAGG}
+\getchunk{COQ ARR2CAT}
+\getchunk{COQ BRAGG}
+\getchunk{COQ DIOPS}
+\getchunk{COQ GROUP}
+\getchunk{COQ LNAGG}
+\getchunk{COQ MATCAT}
+\getchunk{COQ OASGP}
+\getchunk{COQ ORDMON}
+\getchunk{COQ PSETCAT}
+\getchunk{COQ SETAGG}
+\getchunk{COQ URAGG}
+\getchunk{COQ ABELGRP}
+\getchunk{COQ BTCAT}
+\getchunk{COQ DIAGG}
+\getchunk{COQ ELAGG}
+\getchunk{COQ FLAGG}
+\getchunk{COQ STAGG}
+\getchunk{COQ TSETCAT}
+\getchunk{COQ FDIVCAT}
+\getchunk{COQ FSAGG}
+\getchunk{COQ KDAGG}
+\getchunk{COQ LZSTAGG}
+\getchunk{COQ LSAGG}
+\getchunk{COQ NARNG}
+\getchunk{COQ A1AGG}
+\getchunk{COQ RSETCAT}
+\getchunk{COQ RMODULE}
+\getchunk{COQ RNG}
+\getchunk{COQ BMODULE}
+\getchunk{COQ BTAGG}
+\getchunk{COQ NASRING}
+\getchunk{COQ OAMONS}
+\getchunk{COQ RING}
+\getchunk{COQ SRAGG}
+\getchunk{COQ TBAGG}
+\getchunk{COQ VECTCAT}
+\getchunk{COQ DIFRING}
+\getchunk{COQ ENTIRER}
+\getchunk{COQ LALG}
+\getchunk{COQ MODULE}
+\getchunk{COQ ORDRING}
+\getchunk{COQ PDRING}
+\getchunk{COQ RMATCAT}
+\getchunk{COQ OREPCAT}
+\getchunk{COQ ALGEBRA}
+\getchunk{COQ DIFEXT}
+\getchunk{COQ LIECAT}
+\getchunk{COQ LODOCAT}
+\getchunk{COQ NAALG}
+\getchunk{COQ VSPACE}
+\getchunk{COQ DIRPCAT}
+\getchunk{COQ DIVRING}
+\getchunk{COQ FINAALG}
+\getchunk{COQ INTDOM}
+\getchunk{COQ OC}
+\getchunk{COQ QUATCAT}
+\getchunk{COQ SMATCAT}
+\getchunk{COQ AMR}
+\getchunk{COQ FRNAALG}
+\getchunk{COQ GCDDOM}
+\getchunk{COQ FAMR}
+\getchunk{COQ PSCAT}
+\getchunk{COQ UFD}
+\getchunk{COQ EUCDOM}
+\getchunk{COQ PFECAT}
+\getchunk{COQ UPSCAT}
+\getchunk{COQ FIELD}
+\getchunk{COQ INS}
+\getchunk{COQ POLYCAT}
+\getchunk{COQ UTSCAT}
+\getchunk{COQ ACF}
+\getchunk{COQ DPOLCAT}
+\getchunk{COQ FPC}
+\getchunk{COQ FINRALG}
+\getchunk{COQ FS}
+\getchunk{COQ QFCAT}
+\getchunk{COQ RCFIELD}
+\getchunk{COQ RNS}
+\getchunk{COQ RPOLCAT}
+\getchunk{COQ UPOLYC}
+\getchunk{COQ ACFS}
+\getchunk{COQ XF}
+\getchunk{COQ FFIELDC}
+\getchunk{COQ FPS}
+\getchunk{COQ FRAMALG}
+\getchunk{COQ ULSCCAT}
+\getchunk{COQ UPXSCCA}
+\getchunk{COQ FAXF}
+\getchunk{COQ MONOGEN}
+\getchunk{COQ COMPCAT}
+\getchunk{COQ FFCAT}
+End Categories
+\end{chunk}
+
 \chapter{Chunk collections}
 \begin{chunk}{algebra}
 \getchunk{category ABELGRP AbelianGroup}
diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet
index 7a036f9..661d0b4 100644
--- a/books/bookvol10.3.pamphlet
+++ b/books/bookvol10.3.pamphlet
@@ -18,9 +18,7 @@ domain, or package. An ellipse means that the name refers to something
 in the bootstrap set. Thus,
 
 \includegraphics[scale=0.85]{ps/v103colorchart.ps}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%\pagehead{Domain}{ABB}
-%\pagepic{ps/v103domain.ps}{ABB}{1.00}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Chapter A}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -115,12 +113,21 @@ AffinePlane(K):Exports == Implementation where
   
   
 \end{chunk}
+
+\begin{chunk}{COQ AFFPL}
+(* domain AFFPL *)
+(*
+*)
+
+\end{chunk}
+
 \begin{chunk}{AFFPL.dotabb}
 "AFFPL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AFFPL"];
 "AFFSP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AFFSP"];
 "AFFPL" -> "AFFSP"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain AFFPLPS AffinePlaneOverPseudoAlgebraicClosureOfFiniteField}
 
@@ -218,12 +225,21 @@ AffinePlaneOverPseudoAlgebraicClosureOfFiniteField(K):Exports == Impl where
 
   Impl ==> AffinePlane(KK)
 \end{chunk}
+
+\begin{chunk}{COQ AFFPLPS}
+(* domain AFFPLPS *)
+(*
+*)
+
+\end{chunk}
+
 \begin{chunk}{AFFPLPS.dotabb}
 "AFFPLPS" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AFFPLPS"];
 "AFFPL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AFFPL"];
 "AFFPLPS" -> "AFFPL"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain AFFSP AffineSpace}
 
@@ -408,6 +424,123 @@ AffineSpace(dim,K):Exports == Implementation where
         ptt
     
 \end{chunk}
+
+\begin{chunk}{COQ AFFSP}
+(* domain AFFSP *)
+(*
+
+    AffineSpace(dim: NonNegativeInteger,K: Field)
+
+    Rep:= List(K)
+
+    origin : () -> %
+    origin == 
+      new(dim,0$K)$List(K)
+
+    coerce : % -> OutputForm
+    coerce(pt:%):OutputForm == 
+      dd:OutputForm:= ":" :: OutputForm
+      llout:List(OutputForm):=[ hconcat(dd, a::OutputForm) for a in rest pt]
+      lout:= cons( (first pt)::OutputForm , llout)
+      out:= hconcat lout
+      oo:=paren(out)
+      ee:OutputForm:= degree(pt) :: OutputForm
+      oo**ee
+
+    definingField : % -> K
+    definingField(pt) ==
+      K has PseudoAlgebraicClosureOfPerfectFieldCategory => _
+        maxTower(pt@Rep)
+      1$K
+    
+    degree : % -> PositiveInteger
+    degree(pt) ==
+      K has PseudoAlgebraicClosureOfPerfectFieldCategory => _
+        extDegree definingField pt
+      1
+      
+    coerce : % -> List(K)
+    coerce(pt:%):List(K) == 
+      pt@Rep   
+      
+    affinePoint : List(K) -> %
+    affinePoint(pt:LIST(K)) ==
+      pt :: %
+
+    list : % -> List(K)
+    list(ptt) ==
+      ptt@Rep
+
+    pointValue : % -> List(K)
+    pointValue(ptt) ==
+      ptt@Rep
+
+    conjugate : % -> %
+    conjugate(p,e) ==
+      lp:Rep:=p
+      pc:List(K):=[c**e for c in lp]
+      affinePoint(pc)
+
+    rational? : (%,NonNegativeInteger) -> Boolean
+    rational?(p,n) == 
+      p = conjugate(p,n)
+
+    rational? : % -> Boolean
+    rational?(p) ==
+      rational?(p,characteristic()$K)
+
+    removeConjugate : List(%) -> List(%)
+    removeConjugate(l) ==
+      removeConjugate(l,characteristic()$K)
+
+    removeConjugate : (List(%),NonNegativeInteger) -> List(%)
+    removeConjugate(l:LIST(%),n:NNI):LIST(%) ==
+      if K has FiniteFieldCategory then
+        allconj:LIST(%):=empty()
+        conjrem:LIST(%):=empty()
+        for p in l repeat
+          if ^member?(p,allconj) then
+            conjrem:=cons(p,conjrem)
+            allconj:=concat(allconj,orbit(p,n))
+        conjrem
+      else
+        error "The field is not finite"
+
+    conjugate : % -> %
+    conjugate(p) ==
+      conjugate(p,characteristic()$K)
+
+    orbit : % -> List(%)
+    orbit(p) ==
+      orbit(p,characteristic()$K)
+
+    orbit : (%,NonNegativeInteger) -> List(%)
+    orbit(p,e)==
+      if K has FiniteFieldCategory then
+        l:LIST(%):=[p]
+        np:%:=conjugate(p,e)
+        flag:=^(np=p)::Boolean
+        while flag repeat
+          l:=concat(np,l)
+          np:=conjugate(np,e)
+          flag:=not (np=p)::Boolean
+        l
+      else
+        error "Cannot compute the conjugate"
+
+    ?=? : (%,%) -> Boolean
+    aa:% = bb:% ==
+      aa =$Rep bb
+
+    coerce : List(K) -> %
+    coerce(pt:LIST(K)) ==
+        ^(dim=#pt) => error "Le point n'a pas la bonne dimension"
+        ptt:%:= pt
+        ptt
+*)
+
+\end{chunk}
+
 \begin{chunk}{AFFSP.dotabb}
 "AFFSP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AFFSP"];
 "PACPERC" [color=lightblue,href="bookvol10.2.pdf#nameddest=PACPERC"];
@@ -416,6 +549,7 @@ AffineSpace(dim,K):Exports == Implementation where
 "AFFSP" -> "PACPERC"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ALGSC AlgebraGivenByStructuralConstants}
 
@@ -2662,12 +2796,393 @@ AlgebraGivenByStructuralConstants(R:Field, n : PositiveInteger,_
       true
 
 \end{chunk}
+
+\begin{chunk}{COQ ALGSC}
+(* domain ALGSC *)
+(*
+AlgebraGivenByStructuralConstants(R: Field,
+                                  n: PositiveInteger,
+                                  ls: List(Symbol),
+                                  gamma: Vector(Matrix(R))) 
+
+  DirectProduct(n,R) add
+
+    Rep := DirectProduct(n,R)
+
+    x,y : %
+    dp : DirectProduct(n,R)
+    v : V R
+
+    recip : % -> Union(%,"failed")
+    recip(x) == 
+      recip(x)$FiniteRankNonAssociativeAlgebra_&(%,R)
+
+    ?*? : (SquareMatrix(n,R),%) -> %
+    (m:SquareMatrix(n,R))*(x:%) == 
+      apply((m :: Matrix R),x)
+
+    coerce : Vector(R) -> %
+    coerce v == 
+      directProduct(v) :: %
+
+    structuralConstants : () -> Vector(Matrix(R))
+    structuralConstants() == 
+      gamma
+
+    coordinates : % -> Vector(R)
+    coordinates(x) == 
+      vector(entries(x :: Rep)$Rep)$Vector(R)
+
+    er1:="coordinates: first argument is not in linear span of second argument"
+
+    coordinates : (%,Vector(%)) -> Vector(R)
+    coordinates(x,b) ==
+      --not (maxIndex b = n) =>
+      --  error("coordinates: your 'basis' has not the right length")
+      m : NonNegativeInteger := (maxIndex b) :: NonNegativeInteger
+      transitionMatrix   : Matrix R := new(n,m,0$R)$Matrix(R)
+      for i in 1..m repeat
+        setColumn_!(transitionMatrix,i,coordinates(b.i))
+      res : REC := solve(transitionMatrix,coordinates(x))$LSMP
+      if (not every?(zero?$R,first res.basis)) then
+        error("coordinates: warning your 'basis' is linearly dependent")
+      (res.particular  case "failed") => error(er1)
+      (res.particular) :: (Vector R)
+
+    basis : () -> Vector(%)
+    basis() == 
+      [unitVector(i::PositiveInteger)::% for i in 1..n]
+
+    someBasis : () -> Vector(%)
+    someBasis() == 
+      basis()$%
+
+    rank : () -> PositiveInteger
+    rank() == 
+      n
+
+    ?.? : (%,Integer) -> R
+    elt(x,i) == 
+      elt(x:Rep,i)$Rep
+
+    coerce : % -> OutputForm
+    coerce(x:%):OutputForm ==
+      zero?(x::Rep)$Rep => (0$R) :: OutputForm
+      le : List OutputForm := nil
+      for i in 1..n repeat
+        coef : R := elt(x::Rep,i)
+        not zero?(coef)$R =>
+          ((coef) = 1)$R =>
+            -- sy : OutputForm := elt(ls,i)$(List Symbol) :: OutputForm
+            le := cons(elt(ls,i)$(List Symbol) :: OutputForm, le)
+          le := cons(coef :: OutputForm *  elt(ls,i)$(List Symbol)_
+              :: OutputForm, le)
+      reduce("+",le)
+
+    ?*? : (%,%) -> %
+    x * y ==
+      v : Vector R :=  new(n,0)
+      for k in 1..n repeat
+        h : R := 0
+        for i in 1..n repeat
+          for j in 1..n repeat
+            h := h  +$R elt(x,i) *$R elt(y,j) *$R elt(gamma.k,i,j )
+        v.k := h
+      directProduct v
+
+    er2:="algebra satisfies 2*associator(a,b,b)=0 = 2*associator(a,a,b)=0"
+
+    alternative? : () -> Boolean
+    alternative?() ==
+      for i in 1..n repeat
+        -- expression for check of left alternative is symmetric in i and j:
+        -- expression for check of right alternative is symmetric in j and k:
+        for j in 1..i-1 repeat
+          for k in j..n repeat
+            -- right check
+            for r in 1..n repeat
+              res := 0$R
+              for l in 1..n repeat
+                res := res - _
+                  (elt(gamma.l,j,k)+elt(gamma.l,k,j))*elt(gamma.r,i,l)+_
+                  (elt(gamma.l,i,j)*elt(gamma.r,l,k) + elt(gamma.l,i,k)*_
+                  elt(gamma.r,l,j) )
+              not zero? res =>
+                messagePrint("algebra is not right alternative")$OutputForm
+                return false
+        for j in i..n repeat
+          for k in 1..j-1 repeat
+            -- left check
+            for r in 1..n repeat
+              res := 0$R
+              for l in 1..n repeat
+                res := res + _
+                  (elt(gamma.l,i,j)+elt(gamma.l,j,i))*elt(gamma.r,l,k)-_
+                  (elt(gamma.l,j,k)*elt(gamma.r,i,l) + elt(gamma.l,i,k)*_
+                   elt(gamma.r,j,l) )
+              not (zero? res) =>
+                messagePrint("algebra is not left alternative")$OutputForm
+                return false
+
+          for k in j..n repeat
+            -- left check
+            for r in 1..n repeat
+              res := 0$R
+              for l in 1..n repeat
+                res := res + _
+                  (elt(gamma.l,i,j)+elt(gamma.l,j,i))*elt(gamma.r,l,k)-_
+                  (elt(gamma.l,j,k)*elt(gamma.r,i,l) + elt(gamma.l,i,k)*_
+                   elt(gamma.r,j,l) )
+              not (zero? res) =>
+                messagePrint("algebra is not left alternative")$OutputForm
+                return false
+            -- right check
+            for r in 1..n repeat
+              res := 0$R
+              for l in 1..n repeat
+                res := res - _
+                  (elt(gamma.l,j,k)+elt(gamma.l,k,j))*elt(gamma.r,i,l)+_
+                  (elt(gamma.l,i,j)*elt(gamma.r,l,k) + elt(gamma.l,i,k)*_
+                  elt(gamma.r,l,j) )
+              not (zero? res) =>
+                messagePrint("algebra is not right alternative")$OutputForm
+                return false
+
+      messagePrint(er2)$OutputForm
+      true
+
+    associative? : () -> Boolean
+    associative?() ==
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         for r in 1..n repeat
+           res := 0$R
+           for l in 1..n repeat
+             res := res + elt(gamma.l,i,j)*elt(gamma.r,l,k)-_
+                          elt(gamma.l,j,k)*elt(gamma.r,i,l)
+           not (zero? res) =>
+            messagePrint("algebra is not associative")$OutputForm
+            return false
+      messagePrint("algebra is associative")$OutputForm
+      true
+
+    antiAssociative? : () -> Boolean
+    antiAssociative?() ==
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         for r in 1..n repeat
+           res := 0$R
+           for l in 1..n repeat
+             res := res + elt(gamma.l,i,j)*elt(gamma.r,l,k)+_
+                          elt(gamma.l,j,k)*elt(gamma.r,i,l)
+           not (zero? res) =>
+            messagePrint("algebra is not anti-associative")$OutputForm
+            return false
+      messagePrint("algebra is anti-associative")$OutputForm
+      true
+
+    commutative? : () -> Boolean
+    commutative?() ==
+      for i in 1..n repeat
+       for j in (i+1)..n repeat
+        for k in 1..n repeat
+           not ( elt(gamma.k,i,j)=elt(gamma.k,j,i) ) =>
+            messagePrint("algebra is not commutative")$OutputForm
+            return false
+      messagePrint("algebra is commutative")$OutputForm
+      true
+
+    antiCommutative? : () -> Boolean
+    antiCommutative?() ==
+      for i in 1..n repeat
+       for j in i..n repeat
+        for k in 1..n repeat
+          not zero? (i=j => elt(gamma.k,i,i); _
+                                 elt(gamma.k,i,j)+elt(gamma.k,j,i) ) =>
+            messagePrint("algebra is not anti-commutative")$OutputForm
+            return false
+      messagePrint("algebra is anti-commutative")$OutputForm
+      true
+
+    leftAlternative? : () -> Boolean
+    leftAlternative?() ==
+      for i in 1..n repeat
+       -- expression is symmetric in i and j:
+       for j in i..n repeat
+        for k in 1..n repeat
+         for r in 1..n repeat
+           res := 0$R
+           for l in 1..n repeat
+             res := res+(elt(gamma.l,i,j)+elt(gamma.l,j,i))*elt(gamma.r,l,k)-_
+               (elt(gamma.l,j,k)*elt(gamma.r,i,l) + _
+                elt(gamma.l,i,k)*elt(gamma.r,j,l) )
+           not (zero? res) =>
+            messagePrint("algebra is not left alternative")$OutputForm
+            return false
+      messagePrint("algebra is left alternative")$OutputForm
+      true
+
+    rightAlternative? : () -> Boolean
+    rightAlternative?() ==
+      for i in 1..n repeat
+       for j in 1..n repeat
+       -- expression is symmetric in j and k:
+        for k in j..n repeat
+         for r in 1..n repeat
+           res := 0$R
+           for l in 1..n repeat
+             res := res-(elt(gamma.l,j,k)+elt(gamma.l,k,j))*elt(gamma.r,i,l)+_
+               (elt(gamma.l,i,j)*elt(gamma.r,l,k) + _
+                elt(gamma.l,i,k)*elt(gamma.r,l,j) )
+           not (zero? res) =>
+            messagePrint("algebra is not right alternative")$OutputForm
+            return false
+      messagePrint("algebra is right alternative")$OutputForm
+      true
+
+    flexible? : () -> Boolean
+    flexible?() ==
+      for i in 1..n repeat
+       for j in 1..n repeat
+       -- expression is symmetric in i and k:
+        for k in i..n repeat
+         for r in 1..n repeat
+           res := 0$R
+           for l in 1..n repeat
+             res := res + elt(gamma.l,i,j)*elt(gamma.r,l,k)-_
+                          elt(gamma.l,j,k)*elt(gamma.r,i,l)+_
+                          elt(gamma.l,k,j)*elt(gamma.r,l,i)-_
+                          elt(gamma.l,j,i)*elt(gamma.r,k,l)
+           not (zero? res) =>
+            messagePrint("algebra is not flexible")$OutputForm
+            return false
+      messagePrint("algebra is flexible")$OutputForm
+      true
+
+    lieAdmissible? : () -> Boolean
+    lieAdmissible?() ==
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         for r in 1..n repeat
+           res := 0$R
+           for l in 1..n repeat
+             res := res_
+              + (elt(gamma.l,i,j)-elt(gamma.l,j,i))*_
+                (elt(gamma.r,l,k)-elt(gamma.r,k,l)) _
+              + (elt(gamma.l,j,k)-elt(gamma.l,k,j))*_
+                (elt(gamma.r,l,i)-elt(gamma.r,i,l)) _
+              + (elt(gamma.l,k,i)-elt(gamma.l,i,k))*_
+                (elt(gamma.r,l,j)-elt(gamma.r,j,l))
+           not (zero? res) =>
+            messagePrint("algebra is not Lie admissible")$OutputForm
+            return false
+      messagePrint("algebra is Lie admissible")$OutputForm
+      true
+
+    er3:="this algebra is not Jordan admissible, _
+          as 2 is not invertible in the ground ring"
+
+    jordanAdmissible? : () -> Boolean
+    jordanAdmissible?()  ==
+      recip(2 * 1$R) case "failed" =>
+        messagePrint(er3)$OutputForm
+        false
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         for w in 1..n repeat
+          for t in 1..n repeat
+           res := 0$R
+           for l in 1..n repeat
+            for r in 1..n repeat
+             res := res_
+              + (elt(gamma.l,i,j)+elt(gamma.l,j,i))_
+                * (elt(gamma.r,w,k)+elt(gamma.r,k,w))_
+                * (elt(gamma.t,l,r)+elt(gamma.t,r,l))_
+              - (elt(gamma.r,w,k)+elt(gamma.r,k,w))_
+                * (elt(gamma.l,j,r)+elt(gamma.l,r,j))_
+                * (elt(gamma.t,i,l)+elt(gamma.t,l,i))_
+              + (elt(gamma.l,w,j)+elt(gamma.l,j,w))_
+                * (elt(gamma.r,k,i)+elt(gamma.r,i,k))_
+                * (elt(gamma.t,l,r)+elt(gamma.t,r,l))_
+              - (elt(gamma.r,k,i)+elt(gamma.r,k,i))_
+                * (elt(gamma.l,j,r)+elt(gamma.l,r,j))_
+                * (elt(gamma.t,w,l)+elt(gamma.t,l,w))_
+              + (elt(gamma.l,k,j)+elt(gamma.l,j,k))_
+                * (elt(gamma.r,i,w)+elt(gamma.r,w,i))_
+                * (elt(gamma.t,l,r)+elt(gamma.t,r,l))_
+              - (elt(gamma.r,i,w)+elt(gamma.r,w,i))_
+                * (elt(gamma.l,j,r)+elt(gamma.l,r,j))_
+                * (elt(gamma.t,k,l)+elt(gamma.t,l,k))
+           not (zero? res) =>
+             messagePrint("algebra is not Jordan admissible")$OutputForm
+             return false
+      messagePrint("algebra is Jordan admissible")$OutputForm
+      true
+
+    er4:="this is not a Jordan algebra, _
+          as 2 is not invertible in the ground ring"
+
+    jordanAlgebra? : () -> Boolean
+    jordanAlgebra?()  ==
+      recip(2 * 1$R) case "failed" =>
+        messagePrint(er4)$OutputForm
+        false
+      not commutative?() =>
+        messagePrint("this is not a Jordan algebra")$OutputForm
+        false
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         for l in 1..n repeat
+           for t in 1..n repeat
+             res := 0$R
+             for r in 1..n repeat
+               for s in 1..n repeat
+                 res := res +  _
+                   elt(gamma.r,i,j)*elt(gamma.s,l,k)*elt(gamma.t,r,s) - _
+                   elt(gamma.r,l,k)*elt(gamma.s,j,r)*elt(gamma.t,i,s) + _
+                   elt(gamma.r,l,j)*elt(gamma.s,k,k)*elt(gamma.t,r,s) - _
+                   elt(gamma.r,k,i)*elt(gamma.s,j,r)*elt(gamma.t,l,s) + _
+                   elt(gamma.r,k,j)*elt(gamma.s,i,k)*elt(gamma.t,r,s) - _
+                   elt(gamma.r,i,l)*elt(gamma.s,j,r)*elt(gamma.t,k,s)
+                 not zero? res =>
+                   messagePrint("this is not a Jordan algebra")$OutputForm
+                   return false
+      messagePrint("this is a Jordan algebra")$OutputForm
+      true
+
+    jacobiIdentity? : () -> Boolean
+    jacobiIdentity?()  ==
+      for i in 1..n repeat
+       for j in 1..n repeat
+        for k in 1..n repeat
+         for r in 1..n repeat
+           res := 0$R
+           for s in 1..n repeat
+                 res := res +  elt(gamma.r,i,j)*elt(gamma.s,j,k) +_
+                               elt(gamma.r,j,k)*elt(gamma.s,k,i) +_
+                               elt(gamma.r,k,i)*elt(gamma.s,i,j)
+           not zero? res =>
+                 messagePrint("Jacobi identity does not hold")$OutputForm
+                 return false
+      messagePrint("Jacobi identity holds")$OutputForm
+      true
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ALGSC.dotabb}
 "ALGSC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALGSC"]
 "FRNAALG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FRNAALG"]
 "ALGSC" -> "FRNAALG"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ALGFF AlgebraicFunctionField}
 
@@ -3195,12 +3710,175 @@ AlgebraicFunctionField(F, UP, UPUP, modulus): Exports == Implementation where
       not ground? gcd(retract(discriminant())@UP, p)
 
 \end{chunk}
+
+\begin{chunk}{COQ ALGFF}
+(* domain ALGFF *)
+(*
+  SAE add
+
+    import ChangeOfVariable(F, UP, UPUP)
+    import InnerCommonDenominator(UP, RF, Vector UP, Vector RF)
+    import MatrixCommonDenominator(UP, RF)
+    import UnivariatePolynomialCategoryFunctions2(RF, UPUP, UP, UP2)
+
+
+    brandNew?:Reference(Boolean) := ref true
+
+    infBr?:Reference(Boolean) := ref true
+
+    discPoly:Reference(RF) := ref 0
+
+    n  := degree modulus
+
+    n1 := (n - 1)::N
+
+    ibasis:Matrix(RF)     := zero(n, n)
+
+    invibasis:Matrix(RF)  := copy ibasis
+
+    infbasis:Matrix(RF)   := copy ibasis
+
+    invinfbasis:Matrix(RF):= copy ibasis
+
+    branchPointAtInfinity? : () -> Boolean
+    branchPointAtInfinity?() == 
+      (INIT; infBr?())
+
+    discriminant : () -> Fraction(UP)
+    discriminant() == 
+      (INIT; discPoly())
+
+    integralBasis : () -> Vector(%)
+    integralBasis() == 
+      (INIT; vect ibasis)
+
+    integralBasisAtInfinity : () -> Vector(%)
+    integralBasisAtInfinity() == 
+      (INIT; vect infbasis)
+
+    integralMatrix : () -> Matrix(Fraction(UP))
+    integralMatrix() == 
+      (INIT; ibasis)
+
+    inverseIntegralMatrix : () -> Matrix(Fraction(UP))
+    inverseIntegralMatrix() == 
+      (INIT; invibasis)
+
+    integralMatrixAtInfinity : () -> Matrix(Fraction(UP))
+    integralMatrixAtInfinity() == 
+      (INIT; infbasis)
+
+    branchPoint? : F -> Boolean
+    branchPoint?(a:F) == 
+      zero?((retract(discriminant())@UP) a)
+
+    definingPolynomial : () -> UPUP
+    definingPolynomial() == 
+      modulus
+
+    inverseIntegralMatrixAtInfinity : () -> Matrix(Fraction(UP))
+    inverseIntegralMatrixAtInfinity() == 
+      (INIT; invinfbasis)
+
+    vect : Matrix RF -> Vector $
+    vect m ==
+      [represents row(m, i) for i in minRowIndex m .. maxRowIndex m]
+
+    integralCoordinates : % -> Record(num: Vector(UP),den: UP)
+    integralCoordinates f ==
+      splitDenominator(coordinates(f) * inverseIntegralMatrix())
+
+    knownInfBasis : NonNegativeInteger -> Void
+    knownInfBasis d ==
+      if deref brandNew? then
+        alpha := [monomial(1, d * i)$UP :: RF for i in 0..n1]$Vector(RF)
+        ib := diagonalMatrix
+          [inv qelt(alpha, i) for i in minIndex alpha .. maxIndex alpha]
+        invib := diagonalMatrix alpha
+        for i in minRowIndex ib .. maxRowIndex ib repeat
+          for j in minColIndex ib .. maxColIndex ib repeat
+            infbasis(i, j)    := qelt(ib, i, j)
+            invinfbasis(i, j) := invib(i, j)
+      void
+
+    getInfBasis: () -> Void
+    getInfBasis() ==
+      x           := inv(monomial(1, 1)$UP :: RF)
+      invmod      := map(s +-> s(x), modulus)
+      r           := mkIntegral invmod
+      degree(r.poly) ^= n => error "Should not happen"
+      ninvmod:UP2 := map(s +-> retract(s)@UP, r.poly)
+      alpha       := [(r.coef ** i) x for i in 0..n1]$Vector(RF)
+      invalpha := [inv qelt(alpha, i)
+                   for i in minIndex alpha .. maxIndex alpha]$Vector(RF)
+      invib       := integralBasis()$FunctionFieldIntegralBasis(UP, UP2,
+                             SimpleAlgebraicExtension(UP, UP2, ninvmod))
+      for i in minRowIndex ibasis .. maxRowIndex ibasis repeat
+        for j in minColIndex ibasis .. maxColIndex ibasis repeat
+          infbasis(i, j)    := ((invib.basis)(i,j) / invib.basisDen) x
+          invinfbasis(i, j) := ((invib.basisInv) (i, j)) x
+      ib2    := infbasis * diagonalMatrix alpha
+      invib2 := diagonalMatrix(invalpha) * invinfbasis
+      for i in minRowIndex ib2 .. maxRowIndex ib2 repeat
+        for j in minColIndex ibasis .. maxColIndex ibasis repeat
+          infbasis(i, j)    := qelt(ib2, i, j)
+          invinfbasis(i, j) := invib2(i, j)
+      void
+
+    startUp : Boolean -> Void
+    startUp b ==
+      brandNew?() := b
+      nmod:UP2    := map(retract, modulus)
+      ib          := integralBasis()$FunctionFieldIntegralBasis(UP, UP2,
+                                SimpleAlgebraicExtension(UP, UP2, nmod))
+      for i in minRowIndex ibasis .. maxRowIndex ibasis repeat
+        for j in minColIndex ibasis .. maxColIndex ibasis repeat
+          qsetelt_!(ibasis, i, j, (ib.basis)(i, j) / ib.basisDen)
+          invibasis(i, j) := ((ib.basisInv) (i, j))::RF
+      if zero?(infbasis(minRowIndex infbasis, minColIndex infbasis))
+        then getInfBasis()
+      ib2    := coordinates normalizeAtInfinity vect ibasis
+      invib2 := inverse(ib2)::Matrix(RF)
+      for i in minRowIndex ib2 .. maxRowIndex ib2 repeat
+        for j in minColIndex ib2 .. maxColIndex ib2 repeat
+          ibasis(i, j)    := qelt(ib2, i, j)
+          invibasis(i, j) := invib2(i, j)
+      dsc  := resultant(modulus, differentiate modulus)
+      dsc0 := dsc * determinant(infbasis) ** 2
+      degree(numer dsc0) > degree(denom dsc0) =>error "Shouldn't happen"
+      infBr?() := degree(numer dsc0) < degree(denom dsc0)
+      dsc := dsc * determinant(ibasis) ** 2
+      discPoly() := primitivePart(numer dsc) / denom(dsc)
+      void
+
+    integralDerivationMatrix : (UP -> UP) -> Record(num: Matrix(UP),den: UP)
+    integralDerivationMatrix d ==
+      w := integralBasis()
+      splitDenominator(coordinates([differentiate(w.i, d)
+          for i in minIndex w .. maxIndex w]$Vector($))
+               * inverseIntegralMatrix())
+
+    integralRepresents : (Vector(UP),UP) -> %
+    integralRepresents(v, d) ==
+      represents(coordinates(represents(v, d)) * integralMatrix())
+
+    branchPoint? : UP -> Boolean
+    branchPoint?(p:UP) ==
+      INIT
+      (r:=retractIfCan(p)@Union(F,"failed")) case F =>branchPoint?(r::F)
+      not ground? gcd(retract(discriminant())@UP, p)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ALGFF.dotabb}
 "ALGFF" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALGFF"]
 "FFCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FFCAT"]
 "ALGFF" -> "FFCAT"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain AN AlgebraicNumber}
 
@@ -3942,12 +4620,38 @@ AlgebraicNumber(): Exports == Implementation where
       trueEqual((a-b)::Rep,0::Rep)
 
 \end{chunk}
+
+\begin{chunk}{COQ AN}
+(* domain AN *)
+(*
+  InnerAlgebraicNumber add
+
+    Rep:=InnerAlgebraicNumber
+    a,b:%
+
+    zero? : % -> Boolean
+    zero? a == 
+      trueEqual(a::Rep,0::Rep)
+
+    one? : % -> Boolean
+    one? a == 
+      trueEqual(a::Rep,1::Rep)
+
+    ?=? : (%,%) -> Boolean
+    a=b == 
+      trueEqual((a-b)::Rep,0::Rep)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{AN.dotabb}
 "AN" [color="#88FF44",href="bookvol10.3.pdf#nameddest=AN"]
 "ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
 "AN" -> "ACF"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ANON AnonymousFunction}
 
@@ -4013,6 +4717,19 @@ AnonymousFunction():SetCategory == add
     x pretend OutputForm
 
 \end{chunk}
+
+\begin{chunk}{COQ ANON}
+(* domain ANON *)
+(*
+
+  coerce : % -> OutputForm
+  coerce(x:%):OutputForm == 
+    x pretend OutputForm
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ANON.dotabb}
 "ANON" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ANON"]
 "BASTYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=BASTYPE"]
@@ -4021,6 +4738,7 @@ AnonymousFunction():SetCategory == add
 "ANON" -> "KOERCE"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ANTISYM AntiSymm}
 
@@ -4859,12 +5577,165 @@ AntiSymm(R:Ring, lVar:List Symbol): Exports == Implementation where
         reduce(_+,[makeTerm(t.coef,t.base) for t in (a @ Rep)])$L(O)
 
 \end{chunk}
+
+\begin{chunk}{COQ ANTISYM}
+(* domain ANTISYM *)
+(*
+FMR add
+
+      Rep := L Term
+      x,y : EAB
+      a,b : %
+      r : R
+      m : I
+
+      dim := #lVar
+
+      1 : () -> %
+      1 == 
+        [[ Nul(dim)$EAB, 1$R ]]
+
+      coefficient : (%,%) -> R
+      coefficient(a,u) ==
+        not null u.rest => error "2nd argument must be a basis element"
+        x := u.first.base
+        for t in a repeat
+          if t.base = x then return t.coef
+          if t.base < x then return 0
+        0
+
+      retractable? : % -> Boolean
+      retractable?(a) ==
+        null a or (a.first.k  =  Nul(dim))
+
+      retractIfCan : % -> Union(R,"failed")
+      retractIfCan(a):Union(R,"failed") ==
+        null a               => 0$R
+        a.first.k = Nul(dim) => leadingCoefficient a
+        "failed"
+
+      retract : % -> R
+      retract(a):R ==
+        null a => 0$R
+        leadingCoefficient a
+
+      homogeneous? : % -> Boolean
+      homogeneous? a ==
+        null a => true
+        siz := _+/exponents(a.first.base)
+        for ta in reductum a repeat
+          _+/exponents(ta.base) ^= siz => return false
+        true
+
+      degree : % -> NonNegativeInteger
+      degree a ==
+        null a => 0$NNI
+        homogeneous? a => (_+/exponents(a.first.base)) :: NNI
+        error "not a homogeneous element"
+
+      zo : (I,I) -> L I
+      zo(p,q) ==
+        p = 0 => [1,q]
+        q = 0 => [1,1]
+        [0,0]
+
+      getsgn : (EAB,EAB) -> I
+      getsgn(x,y) ==
+        sgn:I  := 0
+        xx:L I := exponents x
+        yy:L I := exponents y
+        for i in 1 .. (dim-1) repeat
+          xx  := rest xx
+          sgn := sgn + (_+/xx)*yy.i
+        sgn rem 2 = 0 => 1
+        -1
+
+      Nalpha: (EAB,EAB) -> L I
+      Nalpha(x,y) ==
+        i:I := 1
+        dum2:L I := [0 for i in 1..dim]
+        for j in 1..dim repeat
+          dum:=zo((exponents x).j,(exponents y).j)
+          (i:= i*dum.1) = 0 => leave
+          dum2.j := dum.2
+        i = 0 => cons(i, dum2)
+        cons(getsgn(x,y), dum2)
+
+      ?*? : (%,%) -> %
+      a * b ==
+        null a => 0
+        null b => 0
+        ((null a.rest) and (a.first.k = Nul(dim))) => a.first.c * b
+        ((null b.rest) and (b.first.k = Nul(dim))) => b.first.c * a
+        z:% := 0
+        for tb in b repeat
+          for ta in a repeat
+            stuff:=Nalpha(ta.base,tb.base)
+            r:=first(stuff)*ta.coef*tb.coef
+            if r ^= 0 then z := z + [[rest(stuff)::EAB, r]]
+        z
+
+      coerce : R -> %
+      coerce(r):% == 
+        r = 0 => 0
+        [ [Nul(dim), r] ]
+
+      coerce : Integer -> %
+      coerce(m):% == 
+        m = 0 => 0
+        [ [Nul(dim), m::R] ]
+
+      characteristic : () -> NonNegativeInteger
+      characteristic() == 
+        characteristic()$R
+
+      generator : NonNegativeInteger -> %
+      generator(j) == 
+        -- j < 1 or j > dim => error "your subscript is out of range"
+        -- error will be generated by dum.j if out of range
+        dum:L I := [0 for i in 1..dim]
+        dum.j:=1
+        [[dum::EAB, 1::R]]
+
+      exp : List(Integer) -> %
+      exp(li:(L I)) == 
+        [[li::EAB, 1]]
+ 
+      leadingBasisTerm : % -> %
+      leadingBasisTerm a ==
+        [[a.first.k, 1]]
+
+      displayList:EAB -> O
+      displayList(x):O ==
+        le: L I := exponents(x)$EAB
+        reduce(_*,[(lVar.i)::O for i in 1..dim | ((le.i) = 1)])$L(O)
+
+      makeTerm:(R,EAB) -> O
+      makeTerm(r,x) ==
+        -- we know that r ^= 0
+        x = Nul(dim)$EAB  => r::O
+        (r = 1) => displayList(x)
+        r::O * displayList(x)
+
+      coerce : % -> OutputForm
+      coerce(a):O ==
+        zero? a     => 0$I::O
+        null rest(a @ Rep) => 
+                 t := first(a @ Rep)
+                 makeTerm(t.coef,t.base)
+        reduce(_+,[makeTerm(t.coef,t.base) for t in (a @ Rep)])$L(O)
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ANTISYM.dotabb}
 "ANTISYM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ANTISYM"]
 "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
 "ANTISYM" -> "ALIST"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ANY Any}
 
@@ -5226,12 +6097,71 @@ Any(): SetCategory with
        error "function any must have a domain as first argument"
 
 \end{chunk}
+
+\begin{chunk}{COQ ANY}
+(* domain ANY *)
+(*
+
+     Rep := Record(dm: SExpression, ob: None)
+
+     printTypeInOutputP:Reference(Boolean) := ref false
+
+     obj : % -> None
+     obj x == 
+       x.ob
+
+     dom : % -> SExpression
+     dom x == 
+       x.dm
+
+     domainOf : % -> OutputForm
+     domainOf x == 
+       x.dm pretend OutputForm
+
+     ?=? : (%,%) -> Boolean
+     x = y == 
+       (x.dm = y.dm) and EQUAL(x.ob, y.ob)$Lisp
+
+     objectOf : % -> OutputForm
+     objectOf(x : %) : OutputForm ==
+       spad2BootCoerce(x.ob, x.dm,
+          list("OutputForm"::Symbol)$List(Symbol))$Lisp
+
+     showTypeInOutput : Boolean -> String
+     showTypeInOutput(b : Boolean) : String ==
+      printTypeInOutputP := ref b
+      b=> "Type of object will be displayed in output of a member of Any"
+      "Type of object will not be displayed in output of a member of Any"
+
+     coerce : % -> OutputForm
+     coerce(x):OutputForm ==
+       obj1 : OutputForm := objectOf x
+       not deref printTypeInOutputP => obj1
+       dom1 :=
+         p:Symbol := prefix2String(devaluate(x.dm)$Lisp)$Lisp
+         atom?(p pretend SExpression) => list(p)$List(Symbol)
+         list(p)$Symbol
+       hconcat cons(obj1,
+         cons(":"::OutputForm, [a::OutputForm for a in dom1]))
+
+     any : (SExpression,None) -> %
+     any(domain, object) ==
+       (isValidType(domain)$Lisp)@Boolean => [domain, object]
+       domain := devaluate(domain)$Lisp
+       (isValidType(domain)$Lisp)@Boolean => [domain, object]
+       error "function any must have a domain as first argument"
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ANY.dotabb}
 "ANY" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ANY"]
 "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
 "ANY" -> "ALIST"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASTACK ArrayStack}
 
@@ -6583,40 +7513,129 @@ ArrayStack(S:SetCategory): StackAggregate(S) with
  
     -- system operations
     # s == _#(s)$Rep
+
+    s = t == s =$Rep t
+
+    copy s == copy(s)$Rep
+
+    coerce(d):OutputForm ==
+        empty? d => empty()$(List S) ::OutputForm
+        [(d.i::OutputForm) for i in 0..#d-1] ::OutputForm
+ 
+    -- stack operations
+
+    depth s == # s
+
+    empty? s == empty?(s)$Rep 
+
+    extract_! s == pop_! s
+
+    insert_!(e,s) == (push_!(e,s);s)
+
+    push_!(e,s) == (concat(e,s); e)
+
+    pop_! s ==
+        if empty? s then error "empty stack"
+        r := s.0
+        delete_!(s,0)
+        r
+
+    top s == if empty? s then error "empty stack" else s.0
+
+    arrayStack l == construct(l)$Rep
+
+    empty() == new(0,0 pretend S)
+
+    parts s == [s.i for i in 0..#s-1]::List(S)
+
+    map(f,s) == construct [f(s.i) for i in 0..#s-1]
+
+    map!(f,s) == ( for i in 0..#s-1 repeat qsetelt!(s,i,f(s.i)) ; s )
+
+    inspect(s) ==  
+        if empty? s then error "empty stack"
+        qelt(s,0)
+
+\end{chunk}
+
+\begin{chunk}{COQ ASTACK}
+(* domain ASTACK *)
+(*
+    Rep := IndexedFlexibleArray(S,0)
+ 
+    -- system operations
+    #? : % -> NonNegativeInteger
+    # s == _#(s)$Rep
+
+    ?=? : (%,%) -> Boolean
     s = t == s =$Rep t
+
+    copy : % -> %
     copy s == copy(s)$Rep
+
+    coerce : % -> OutputForm
     coerce(d):OutputForm ==
         empty? d => empty()$(List S) ::OutputForm
         [(d.i::OutputForm) for i in 0..#d-1] ::OutputForm
  
     -- stack operations
+
+    depth : % -> NonNegativeInteger
     depth s == # s
+
+    empty? : % -> Boolean
     empty? s == empty?(s)$Rep 
+
+    extract! : % -> S
     extract_! s == pop_! s
+
+    insert! : (S,%) -> %
     insert_!(e,s) == (push_!(e,s);s)
+
+    push! : (S,%) -> S
     push_!(e,s) == (concat(e,s); e)
+
+    pop! : % -> S
     pop_! s ==
         if empty? s then error "empty stack"
         r := s.0
         delete_!(s,0)
         r
+
+    top : % -> S
     top s == if empty? s then error "empty stack" else s.0
+
+    arrayStack : List(S) -> %
     arrayStack l == construct(l)$Rep
+
+    empty : () -> %
     empty() == new(0,0 pretend S)
+
+    parts : % -> List(S)
     parts s == [s.i for i in 0..#s-1]::List(S)
+
+    map : ((S -> S),%) -> %
     map(f,s) == construct [f(s.i) for i in 0..#s-1]
+
+    map! : ((S -> S),%) -> %
     map!(f,s) == ( for i in 0..#s-1 repeat qsetelt!(s,i,f(s.i)) ; s )
+
+    inspect : % -> S
     inspect(s) ==  
         if empty? s then error "empty stack"
         qelt(s,0)
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{ASTACK.dotabb}
 "ASTACK" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASTACK"]
 "A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"]
 "ASTACK" -> "A1AGG"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP1 Asp1}
 
@@ -6727,76 +7746,185 @@ Asp1(name): Exports == Implementation where
 
     -- Build Symbol Table for Rep
     syms : SYMTAB := empty()$SYMTAB
+
+    declare!(X,fortranReal()$FT,syms)$SYMTAB
+
+    real : FST := "real"::FST
+
+    Rep := FortranProgram(name,[real]$Union(fst:FST,void:"void"),[X],syms)
+
+    retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
+      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
+      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+      foo case "failed" => "failed"
+      foo::FEXPR(['X],[],MachineFloat)::$
+
+    retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
+      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
+      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+      foo case "failed" => "failed"
+      foo::FEXPR(['X],[],MachineFloat)::$
+
+    retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
+      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
+      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+      foo case "failed" => "failed"
+      foo::FEXPR(['X],[],MachineFloat)::$
+
+    retract(u:EXPR INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan(u:EXPR INT):Union($,"failed") ==
+      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
+      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+      foo case "failed" => "failed"
+      foo::FEXPR(['X],[],MachineFloat)::$
+
+    retract(u:POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan(u:POLY FLOAT):Union($,"failed") ==
+      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
+      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+      foo case "failed" => "failed"
+      foo::FEXPR(['X],[],MachineFloat)::$
+
+    retract(u:POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan(u:POLY INT):Union($,"failed") ==
+      foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
+      foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
+      foo case "failed" => "failed"
+      foo::FEXPR(['X],[],MachineFloat)::$
+
+    coerce(u:FEXPR(['X],[],MachineFloat)):$ ==
+      coerce((u::Expression(MachineFloat))$FEXPR(['X],[],MachineFloat))$Rep
+
+    coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+    coerce(r:RSFC):$ == coerce(r)$Rep
+
+    coerce(c:FortranCode):$ == coerce(c)$Rep
+
+    coerce(u:$):OutputForm == coerce(u)$Rep
+
+    outputAsFortran(u):Void == 
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
+
+\end{chunk}
+
+\begin{chunk}{COQ ASP1}
+(* domain ASP1 *)
+(*
+
+    -- Build Symbol Table for Rep
+    syms : SYMTAB := empty()$SYMTAB
+
     declare!(X,fortranReal()$FT,syms)$SYMTAB
+
     real : FST := "real"::FST
 
     Rep := FortranProgram(name,[real]$Union(fst:FST,void:"void"),[X],syms)
 
+    retract : Fraction(Polynomial(Integer)) -> %
     retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan : Fraction(Polynomial(Integer)) -> Union(%,"failed")
     retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
       foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
       foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
       foo case "failed" => "failed"
       foo::FEXPR(['X],[],MachineFloat)::$
 
+    retract : Fraction(Polynomial(Float)) -> %
     retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan : Fraction(Polynomial(Float)) -> Union(%,"failed")
     retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
       foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
       foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
       foo case "failed" => "failed"
       foo::FEXPR(['X],[],MachineFloat)::$
 
+    retract : Expression(Float) -> %
     retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan : Expression(Float) -> Union(%,"failed")
     retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
       foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
       foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
       foo case "failed" => "failed"
       foo::FEXPR(['X],[],MachineFloat)::$
 
+    retract : Expression(Integer) -> %
     retract(u:EXPR INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan : Expression(Integer) -> Union(%,"failed")
     retractIfCan(u:EXPR INT):Union($,"failed") ==
       foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
       foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
       foo case "failed" => "failed"
       foo::FEXPR(['X],[],MachineFloat)::$
 
+    retract : Polynomial(Float) -> %
     retract(u:POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan : Polynomial(Float) -> Union(%,"failed")
     retractIfCan(u:POLY FLOAT):Union($,"failed") ==
       foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
       foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
       foo case "failed" => "failed"
       foo::FEXPR(['X],[],MachineFloat)::$
 
+    retract : Polynomial(Integer) -> %
     retract(u:POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$
+
+    retractIfCan : Polynomial(Integer) -> Union(%,"failed")
     retractIfCan(u:POLY INT):Union($,"failed") ==
       foo : Union(FEXPR(['X],[],MachineFloat),"failed") 
       foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat)
       foo case "failed" => "failed"
       foo::FEXPR(['X],[],MachineFloat)::$
 
+    coerce: FortranExpression([construct,QUOTEX],[construct],MachineFloat) -> %
     coerce(u:FEXPR(['X],[],MachineFloat)):$ ==
       coerce((u::Expression(MachineFloat))$FEXPR(['X],[],MachineFloat))$Rep
 
+    coerce : List(FortranCode) -> %
     coerce(c:List FortranCode):$ == coerce(c)$Rep
 
+    coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
     coerce(r:RSFC):$ == coerce(r)$Rep
 
+    coerce : FortranCode -> %
     coerce(c:FortranCode):$ == coerce(c)$Rep
 
+    coerce : % -> OutputForm
     coerce(u:$):OutputForm == coerce(u)$Rep
 
+    outputAsFortran : % -> Void
     outputAsFortran(u):Void == 
       p := checkPrecision()$NAGLinkSupportPackage
       outputAsFortran(u)$Rep
       p => restorePrecision()$NAGLinkSupportPackage
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{ASP1.dotabb}
 "ASP1" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP1"]
 "PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
 "ASP1" -> "PFECAT"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP10 Asp10}
 
@@ -6916,13 +8044,21 @@ Asp10(name): Exports == Implementation where
   Implementation ==> add
 
     real : FST := "real"::FST
+
     syms : SYMTAB := empty()$SYMTAB
+
     declare!(P,fortranReal()$FT,syms)$SYMTAB
+
     declare!(Q,fortranReal()$FT,syms)$SYMTAB
+
     declare!(DQDL,fortranReal()$FT,syms)$SYMTAB
+
     declare!(X,fortranReal()$FT,syms)$SYMTAB
+
     declare!(ELAM,fortranReal()$FT,syms)$SYMTAB
+
     declare!(JINT,fortranInteger()$FT,syms)$SYMTAB
+
     Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"),
                           [P,Q,DQDL,X,ELAM,JINT],syms)
 
@@ -6940,7 +8076,8 @@ Asp10(name): Exports == Implementation where
       v::$
 
     retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
-      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v:Union(VEC FEXPR,"failed"):=_
+         map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
@@ -7006,12 +8143,142 @@ Asp10(name): Exports == Implementation where
       p => restorePrecision()$NAGLinkSupportPackage
 
 \end{chunk}
+
+\begin{chunk}{COQ ASP10}
+(* domain ASP10 *)
+(*
+
+    real : FST := "real"::FST
+
+    syms : SYMTAB := empty()$SYMTAB
+
+    declare!(P,fortranReal()$FT,syms)$SYMTAB
+
+    declare!(Q,fortranReal()$FT,syms)$SYMTAB
+
+    declare!(DQDL,fortranReal()$FT,syms)$SYMTAB
+
+    declare!(X,fortranReal()$FT,syms)$SYMTAB
+
+    declare!(ELAM,fortranReal()$FT,syms)$SYMTAB
+
+    declare!(JINT,fortranInteger()$FT,syms)$SYMTAB
+
+    Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"),
+                          [P,Q,DQDL,X,ELAM,JINT],syms)
+
+    retract : Vector(Fraction(Polynomial(Integer))) -> %
+    retract(u:VEC FRAC POLY INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Fraction(Polynomial(Integer))) -> Union(%,"failed")
+    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract : Vector(Fraction(Polynomial(Float))) -> %
+    retract(u:VEC FRAC POLY FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Fraction(Polynomial(Float))) -> Union(%,"failed")
+    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=_
+         map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract : Vector(Expression(Integer)) -> %
+    retract(u:VEC EXPR INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Expression(Integer)) -> Union(%,"failed")
+    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract : Vector(Expression(Float)) -> %
+    retract(u:VEC EXPR FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Expression(Float)) -> Union(%,"failed")
+    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract : Vector(Polynomial(Integer)) -> %
+    retract(u:VEC POLY INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Polynomial(Integer)) -> Union(%,"failed")
+    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract : Vector(Polynomial(Float)) -> %
+    retract(u:VEC POLY FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Polynomial(Float)) -> Union(%,"failed")
+    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    coerce : FortranCode -> %
+    coerce(c:FortranCode):% == coerce(c)$Rep
+
+   coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
+   coerce(r:RSFC):% == coerce(r)$Rep
+
+    coerce : List(FortranCode) -> %
+    coerce(c:List FortranCode):% == coerce(c)$Rep
+
+    -- To help the poor old compiler!
+    localAssign : (s:Symbol,u:Expression MFLOAT) -> FortranCode
+    localAssign(s:Symbol,u:Expression MFLOAT):FortranCode == 
+      assign(s,u)$FortranCode
+
+    coerce : 
+       Vector(FortranExpression([construct,QUOTEJINT,QUOTEX,QUOTEELAM],
+                                [construct],MachineFloat)) -> %
+    coerce(u:Vector FEXPR):% ==
+      import Vector FEXPR
+      not (#u = 3) => error "Incorrect Dimension For Vector"
+      ([localAssign(P,elt(u,1)::Expression MFLOAT),_
+        localAssign(Q,elt(u,2)::Expression MFLOAT),_
+        localAssign(DQDL,elt(u,3)::Expression MFLOAT),_
+        returns()$FortranCode ]$List(FortranCode))::Rep
+
+    coerce : % -> OutputForm
+    coerce(u:%):OutputForm == coerce(u)$Rep
+
+    outputAsFortran : % -> Void
+    outputAsFortran(u):Void ==
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ASP10.dotabb}
 "ASP10" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP10"]
 "PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
 "ASP10" -> "PFECAT"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP12 Asp12}
 
@@ -7116,32 +8383,86 @@ Asp12(name): Exports == Implementation where
     import Switch
 
     real : FST := "real"::FST
+
     syms : SYMTAB := empty()$SYMTAB
+
     declare!(MAXIT,fortranInteger()$FT,syms)$SYMTAB
+
     declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB
+
     declare!(ELAM,fortranReal()$FT,syms)$SYMTAB
+
     fType : FT := construct([real]$UFST,["15"::Symbol],false)$FT
+
     declare!(FINFO,fType,syms)$SYMTAB
+
     Rep := FortranProgram(name,["void"]$UFST,[MAXIT,IFLAG,ELAM,FINFO],syms)
 
     -- eqn : O := (I::O)=(1@Integer::EXI::O)
     code:=([cond(EQ([MAXIT@S::EXI]$U,[-1::EXI]$U),
                  printStatement(["_"Output from Monit_""::O])),
-            printStatement([MAXIT::O,IFLAG::O,ELAM::O,subscript("(FINFO"::S,[I::O])::O,"I=1"::S::O,"4)"::S::O]), -- YUCK!
+            printStatement([MAXIT::O,IFLAG::O,ELAM::O,_
+             subscript("(FINFO"::S,[I::O])::O,"I=1"::S::O,"4)"::S::O]),
             returns()]$List(FortranCode))::Rep
 
     coerce(u:%):OutputForm == coerce(u)$Rep
 
     outputAsFortran(u:%):Void == outputAsFortran(u)$Rep
+
     outputAsFortran():Void == outputAsFortran(code)$Rep  
 
 \end{chunk}
+
+\begin{chunk}{COQ ASP12}
+(* domain ASP12 *)
+(*
+
+    import FC
+    import Switch
+
+    real : FST := "real"::FST
+
+    syms : SYMTAB := empty()$SYMTAB
+
+    declare!(MAXIT,fortranInteger()$FT,syms)$SYMTAB
+
+    declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB
+
+    declare!(ELAM,fortranReal()$FT,syms)$SYMTAB
+
+    fType : FT := construct([real]$UFST,["15"::Symbol],false)$FT
+
+    declare!(FINFO,fType,syms)$SYMTAB
+
+    Rep := FortranProgram(name,["void"]$UFST,[MAXIT,IFLAG,ELAM,FINFO],syms)
+
+    -- eqn : O := (I::O)=(1@Integer::EXI::O)
+    code:=([cond(EQ([MAXIT@S::EXI]$U,[-1::EXI]$U),
+                 printStatement(["_"Output from Monit_""::O])),
+            printStatement([MAXIT::O,IFLAG::O,ELAM::O,_
+             subscript("(FINFO"::S,[I::O])::O,"I=1"::S::O,"4)"::S::O]),
+            returns()]$List(FortranCode))::Rep
+
+    coerce : % -> OutputForm
+    coerce(u:%):OutputForm == coerce(u)$Rep
+
+    outputAsFortran : % -> Void
+    outputAsFortran(u:%):Void == outputAsFortran(u)$Rep
+
+    outputAsFortran : () -> Void
+    outputAsFortran():Void == outputAsFortran(code)$Rep  
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ASP12.dotabb}
 "ASP12" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP12"]
 "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
 "ASP12" -> "ALIST"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP19 Asp19}
 
@@ -7454,16 +8775,27 @@ Asp19(name): Exports == Implementation where
   Implementation ==> add
 
     real : FSTU := ["real"::FST]$FSTU
+
     syms : SYMTAB := empty()$SYMTAB
+
     declare!(M,fortranInteger()$FT,syms)$SYMTAB
+
     declare!(N,fortranInteger()$FT,syms)$SYMTAB
+
     declare!(LJC,fortranInteger()$FT,syms)$SYMTAB
+
     xcType : FT := construct(real,[N],false)$FT
+
     declare!(XC,xcType,syms)$SYMTAB
+
     fveccType : FT := construct(real,[M],false)$FT
+
     declare!(FVECC,fveccType,syms)$SYMTAB
+
     fjaccType : FT := construct(real,[LJC,N],false)$FT
+
     declare!(FJACC,fjaccType,syms)$SYMTAB
+
     Rep := FortranProgram(name,["void"]$FSTU,[M,N,XC,FVECC,FJACC,LJC],syms)
 
     coerce(c:List FC):$ == coerce(c)$Rep
@@ -7496,7 +8828,7 @@ Asp19(name): Exports == Implementation where
       seg2 : Segment (POLY INT) := segment(1::(POLY INT),N@S::(POLY INT))
       s1 : SegmentBinding POLY INT := equation(I@S,seg1)
       s2 : SegmentBinding POLY INT := equation(J@S,seg2)
-      as : FC := assign(FJACC,[I@S::(POLY INT),J@S::(POLY INT)],0.0::EXPR FLOAT)
+      as : FC:= assign(FJACC,[I@S::(POLY INT),J@S::(POLY INT)],0.0::EXPR FLOAT)
       clear : FC := forLoop(s1,forLoop(s2,as))
       j:Integer
       x:S := XC::S
@@ -7512,7 +8844,7 @@ Asp19(name): Exports == Implementation where
       for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p)
       p:= reverse(p)
       jac:Matrix(FEXPR) := _
-      jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
+       jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
       c1:FC := localAssign2(FVECC,u)
       c2:FC := localAssign1(FJACC,jac)
       [clear,c1,c2,returns()]$List(FC)::$
@@ -7524,68 +8856,235 @@ Asp19(name): Exports == Implementation where
       outputAsFortran(u)$Rep
       p => restorePrecision()$NAGLinkSupportPackage
 
+    retract(u:VEC FRAC POLY INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+      v::$
+
+    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract(u:VEC FRAC POLY FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v::$
+
+    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=_
+        map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract(u:VEC EXPR INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+      v::$
+
+    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract(u:VEC EXPR FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+      v::$
+
+    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract(u:VEC POLY INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+      v::$
+
+    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract(u:VEC POLY FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+      v::$
+
+    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+\end{chunk}
+
+\begin{chunk}{COQ ASP19}
+(* domain ASP19 *)
+(*
+
+    real : FSTU := ["real"::FST]$FSTU
+
+    syms : SYMTAB := empty()$SYMTAB
+
+    declare!(M,fortranInteger()$FT,syms)$SYMTAB
+
+    declare!(N,fortranInteger()$FT,syms)$SYMTAB
+
+    declare!(LJC,fortranInteger()$FT,syms)$SYMTAB
+
+    xcType : FT := construct(real,[N],false)$FT
+
+    declare!(XC,xcType,syms)$SYMTAB
+
+    fveccType : FT := construct(real,[M],false)$FT
+
+    declare!(FVECC,fveccType,syms)$SYMTAB
+
+    fjaccType : FT := construct(real,[LJC,N],false)$FT
+
+    declare!(FJACC,fjaccType,syms)$SYMTAB
+
+    Rep := FortranProgram(name,["void"]$FSTU,[M,N,XC,FVECC,FJACC,LJC],syms)
+
+    coerce(c:List FC):$ == coerce(c)$Rep
+
+    coerce(r:RSFC):$ == coerce(r)$Rep
+
+    coerce(c:FC):$ == coerce(c)$Rep
+
+    -- Take a symbol, pull of the script and turn it into an integer!!
+    o2int : S -> Integer
+    o2int(u:S):Integer ==
+      o : OutputForm := first elt(scripts(u)$S,sub)
+      o pretend Integer
+
+    -- To help the poor old compiler!
+    fexpr2expr : FEXPR -> EXPR MFLOAT
+    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+    localAssign1 : (S, Matrix FEXPR) -> FC
+    localAssign1(s:S,j:Matrix FEXPR):FC == 
+      j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2
+      assign(s,j')$FC
+
+    localAssign2 : (S, VEC FEXPR) -> FC
+    localAssign2(s:S,j:VEC FEXPR):FC ==
+      j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
+      assign(s,j')$FC
+
+    coerce : Vector(FortranExpression([construct],
+                                      [construct,QUOTEXC],MachineFloat)) -> %
+    coerce(u:VEC FEXPR):$ ==
+      -- First zero the Jacobian matrix in case we miss some derivatives which
+      -- are zero.
+      import POLY INT
+      seg1 : Segment (POLY INT) := segment(1::(POLY INT),LJC@S::(POLY INT))
+      seg2 : Segment (POLY INT) := segment(1::(POLY INT),N@S::(POLY INT))
+      s1 : SegmentBinding POLY INT := equation(I@S,seg1)
+      s2 : SegmentBinding POLY INT := equation(J@S,seg2)
+      as : FC:= assign(FJACC,[I@S::(POLY INT),J@S::(POLY INT)],0.0::EXPR FLOAT)
+      clear : FC := forLoop(s1,forLoop(s2,as))
+      j:Integer
+      x:S := XC::S
+      pu:List(S) := []
+      -- Work out which variables appear in the expressions
+      for e in entries(u) repeat
+        pu := setUnion(pu,variables(e)$FEXPR)
+      scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer)
+      -- This should be the maximum XC_n which occurs (there may be others
+      -- which don't):
+      n:Integer := reduce(max,scriptList)$List(Integer)
+      p:List(S) := []
+      for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p)
+      p:= reverse(p)
+      jac:Matrix(FEXPR) := _
+       jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S))
+      c1:FC := localAssign2(FVECC,u)
+      c2:FC := localAssign1(FJACC,jac)
+      [clear,c1,c2,returns()]$List(FC)::$
+
+    coerce : % -> OutputForm
+    coerce(u:$):OutputForm == coerce(u)$Rep
+
+    outputAsFortran : % -> Void
+    outputAsFortran(u):Void ==
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
 
+    retract : Vector(Fraction(Polynomial(Integer))) -> %
     retract(u:VEC FRAC POLY INT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Fraction(Polynomial(Integer))) -> Union(%,"failed")
     retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
       v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+    retract : Vector(Fraction(Polynomial(Float))) -> %
     retract(u:VEC FRAC POLY FLOAT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Fraction(Polynomial(Float))) -> Union(%,"failed")
     retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
-      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v:Union(VEC FEXPR,"failed"):=_
+        map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+    retract : Vector(Expression(Integer)) -> %
     retract(u:VEC EXPR INT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Expression(Integer)) -> Union(%,"failed")
     retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
       v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+    retract : Vector(Expression(Float)) -> %
     retract(u:VEC EXPR FLOAT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Expression(Float)) -> Union(%,"failed")
     retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
       v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+    retract : Vector(Polynomial(Integer)) -> %
     retract(u:VEC POLY INT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Polynomial(Integer)) -> Union(%,"failed")
     retractIfCan(u:VEC POLY INT):Union($,"failed") ==
       v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+    retract : Vector(Polynomial(Float)) -> %
     retract(u:VEC POLY FLOAT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Polynomial(Float)) -> Union(%,"failed")
     retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
       v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{ASP19.dotabb}
 "ASP19" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP19"]
 "FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
 "ASP19" -> "FS"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP20 Asp20}
 
@@ -7728,16 +9227,27 @@ Asp20(name): Exports == Implementation where
   Implementation ==> add
 
     real : UFST := ["real"::FST]$UFST
+
     syms : SYMTAB := empty()
+
     declare!(N,fortranInteger(),syms)$SYMTAB
+
     declare!(NROWH,fortranInteger(),syms)$SYMTAB
+
     declare!(NCOLH,fortranInteger(),syms)$SYMTAB
+
     declare!(JTHCOL,fortranInteger(),syms)$SYMTAB
+
     hessType : FT := construct(real,[NROWH,NCOLH],false)$FT
+
     declare!(HESS,hessType,syms)$SYMTAB
+
     xType : FT := construct(real,[N],false)$FT
+
     declare!(X,xType,syms)$SYMTAB
+
     declare!(HX,xType,syms)$SYMTAB
+
     Rep := FortranProgram(name,["void"]$UFST,
                           [N,NROWH,NCOLH,JTHCOL,HESS,X,HX],syms)
 
@@ -7824,12 +9334,151 @@ Asp20(name): Exports == Implementation where
       p => restorePrecision()$NAGLinkSupportPackage
 
 \end{chunk}
+
+\begin{chunk}{COQ ASP20}
+(* domain ASP20 *)
+(*
+
+    real : UFST := ["real"::FST]$UFST
+
+    syms : SYMTAB := empty()
+
+    declare!(N,fortranInteger(),syms)$SYMTAB
+
+    declare!(NROWH,fortranInteger(),syms)$SYMTAB
+
+    declare!(NCOLH,fortranInteger(),syms)$SYMTAB
+
+    declare!(JTHCOL,fortranInteger(),syms)$SYMTAB
+
+    hessType : FT := construct(real,[NROWH,NCOLH],false)$FT
+
+    declare!(HESS,hessType,syms)$SYMTAB
+
+    xType : FT := construct(real,[N],false)$FT
+
+    declare!(X,xType,syms)$SYMTAB
+
+    declare!(HX,xType,syms)$SYMTAB
+
+    Rep := FortranProgram(name,["void"]$UFST,
+                          [N,NROWH,NCOLH,JTHCOL,HESS,X,HX],syms)
+
+    coerce : List(FortranCode) -> %
+    coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+    coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
+    coerce(r:RSFC):$ == coerce(r)$Rep
+
+    coerce : FortranCode -> %
+    coerce(c:FortranCode):$ == coerce(c)$Rep
+
+    -- To help the poor old compiler!
+    fexpr2expr : FEXPR -> EXPR MFLOAT
+    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+    localAssign : (Symbol, VEC FEXPR) -> FortranCode
+    localAssign(s:Symbol,j:VEC FEXPR):FortranCode ==
+      j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
+      assign(s,j')$FortranCode
+
+    coerce : Matrix(FortranExpression([construct],
+                                      [construct,QUOTEX,QUOTEHESS],
+                                      MachineFloat)) -> %
+    coerce(u:MAT FEXPR):$ ==
+      j:Integer
+      x:Symbol := X::Symbol
+      n := nrows(u)::PI
+      p:VEC FEXPR := [retract(subscript(x,[j::O])$Symbol)@FEXPR for j in 1..n]
+      prod:VEC FEXPR := u*p
+      ([localAssign(HX,prod),returns()$FortranCode]$List(FortranCode))::$
+
+    retract : Matrix(Fraction(Polynomial(Integer))) -> %
+    retract(u:MAT FRAC POLY INT):$ ==
+      v : MAT FEXPR := map(retract,u)$MF2a
+      v::$
+
+    retractIfCan : Matrix(Fraction(Polynomial(Integer))) -> Union(%,"failed")
+    retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") ==
+      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a
+      v case "failed" => "failed"
+      (v::MAT FEXPR)::$
+
+    retract : Matrix(Fraction(Polynomial(Float))) -> %
+    retract(u:MAT FRAC POLY FLOAT):$ ==
+      v : MAT FEXPR := map(retract,u)$MF2b
+      v::$
+
+    retractIfCan : Matrix(Fraction(Polynomial(Float))) -> Union(%,"failed")
+    retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") ==
+      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b
+      v case "failed" => "failed"
+      (v::MAT FEXPR)::$
+
+    retract : Matrix(Expression(Integer)) -> %
+    retract(u:MAT EXPR INT):$ ==
+      v : MAT FEXPR := map(retract,u)$MF2e
+      v::$
+
+    retractIfCan : Matrix(Expression(Integer)) -> Union(%,"failed")
+    retractIfCan(u:MAT EXPR INT):Union($,"failed") ==
+      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e
+      v case "failed" => "failed"
+      (v::MAT FEXPR)::$
+
+    retract : Matrix(Expression(Float)) -> %
+    retract(u:MAT EXPR FLOAT):$ ==
+      v : MAT FEXPR := map(retract,u)$MF2f
+      v::$
+
+    retractIfCan : Matrix(Expression(Float)) -> Union(%,"failed")
+    retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") ==
+      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f
+      v case "failed" => "failed"
+      (v::MAT FEXPR)::$
+
+    retract : Matrix(Polynomial(Integer)) -> %
+    retract(u:MAT POLY INT):$ ==
+      v : MAT FEXPR := map(retract,u)$MF2c
+      v::$
+
+    retractIfCan : Matrix(Polynomial(Integer)) -> Union(%,"failed")
+    retractIfCan(u:MAT POLY INT):Union($,"failed") ==
+      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c
+      v case "failed" => "failed"
+      (v::MAT FEXPR)::$
+
+    retract : Matrix(Polynomial(Float)) -> %
+    retract(u:MAT POLY FLOAT):$ ==
+      v : MAT FEXPR := map(retract,u)$MF2d
+      v::$
+
+    retractIfCan : Matrix(Polynomial(Float)) -> Union(%,"failed")
+    retractIfCan(u:MAT POLY FLOAT):Union($,"failed") ==
+      v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d
+      v case "failed" => "failed"
+      (v::MAT FEXPR)::$
+
+    coerce : % -> OutputForm
+    coerce(u:$):O == coerce(u)$Rep
+
+    outputAsFortran : % -> Void
+    outputAsFortran(u):Void ==
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ASP20.dotabb}
 "ASP20" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP20"]
 "FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
 "ASP20" -> "FS"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP24 Asp24}
 
@@ -7950,80 +9599,199 @@ Asp24(name): Exports == Implementation where
 
   Implementation ==> add
 
+    real : FSTU := ["real"::FST]$FSTU
+
+    syms : SYMTAB := empty()
+
+    declare!(N,fortranInteger(),syms)$SYMTAB
+
+    xcType : FT := construct(real,[N::Symbol],false)$FT
+
+    declare!(XC,xcType,syms)$SYMTAB
+
+    declare!(FC,fortranReal(),syms)$SYMTAB
+
+    Rep := FortranProgram(name,["void"]$FSTU,[N,XC,FC],syms)
+
+    coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+    coerce(r:RSFC):$ == coerce(r)$Rep
+
+    coerce(c:FortranCode):$ == coerce(c)$Rep
+
+    coerce(u:FEXPR):$ ==
+      coerce(assign(FC,u::Expression(MachineFloat))$FortranCode)$Rep
+
+    retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      (foo::FEXPR)::$
+
+    retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      (foo::FEXPR)::$
+
+    retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      (foo::FEXPR)::$
+
+    retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan(u:EXPR INT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      (foo::FEXPR)::$
+
+    retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan(u:POLY FLOAT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      (foo::FEXPR)::$
+
+    retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan(u:POLY INT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      (foo::FEXPR)::$
+
+    coerce(u:$):OutputForm == coerce(u)$Rep
+
+    outputAsFortran(u):Void ==
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
+
+\end{chunk}
+
+\begin{chunk}{COQ ASP24}
+(* domain ASP24 *)
+(*
+FortranFunctionCategory with
 
     real : FSTU := ["real"::FST]$FSTU
+
     syms : SYMTAB := empty()
+
     declare!(N,fortranInteger(),syms)$SYMTAB
+
     xcType : FT := construct(real,[N::Symbol],false)$FT
+
     declare!(XC,xcType,syms)$SYMTAB
+
     declare!(FC,fortranReal(),syms)$SYMTAB
+
     Rep := FortranProgram(name,["void"]$FSTU,[N,XC,FC],syms)
 
+    coerce : List(FortranCode) -> %
     coerce(c:List FortranCode):$ == coerce(c)$Rep
 
+    coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
     coerce(r:RSFC):$ == coerce(r)$Rep
 
+    coerce : FortranCode -> %
     coerce(c:FortranCode):$ == coerce(c)$Rep
 
+    coerce : FortranExpression([construct],
+                               [construct,QUOTEXC],MachineFloat) -> %
     coerce(u:FEXPR):$ ==
       coerce(assign(FC,u::Expression(MachineFloat))$FortranCode)$Rep
 
+    retract : Fraction(Polynomial(Integer)) -> %
     retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Fraction(Polynomial(Integer)) -> Union(%,"failed")
     retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
       foo case "failed" => "failed"
       (foo::FEXPR)::$
 
+    retract : Fraction(Polynomial(Float)) -> %
     retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Fraction(Polynomial(Float)) -> Union(%,"failed")
     retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
       foo case "failed" => "failed"
       (foo::FEXPR)::$
 
+    retract : Expression(Float) -> %
     retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Expression(Float) -> Union(%,"failed")
     retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
       foo case "failed" => "failed"
       (foo::FEXPR)::$
 
+    retract : Expression(Integer) -> %
     retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Expression(Integer) -> Union(%,"failed")
     retractIfCan(u:EXPR INT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
       foo case "failed" => "failed"
       (foo::FEXPR)::$
 
+    retract : Polynomial(Float) -> %
     retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Polynomial(Float) -> Union(%,"failed")
     retractIfCan(u:POLY FLOAT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
       foo case "failed" => "failed"
       (foo::FEXPR)::$
 
+    retract : Polynomial(Integer) -> %
     retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Polynomial(Integer) -> Union(%,"failed")
     retractIfCan(u:POLY INT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
       foo case "failed" => "failed"
       (foo::FEXPR)::$
 
+    coerce : % -> OutputForm
     coerce(u:$):OutputForm == coerce(u)$Rep
 
+    outputAsFortran : % -> Void
     outputAsFortran(u):Void ==
       p := checkPrecision()$NAGLinkSupportPackage
       outputAsFortran(u)$Rep
       p => restorePrecision()$NAGLinkSupportPackage
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{ASP24.dotabb}
 "ASP24" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP24"]
 "PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
 "ASP24" -> "PFECAT"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP27 Asp27}
 
@@ -8132,33 +9900,111 @@ Asp27(name): Exports == Implementation where
   MAT    ==> Matrix
   MFLOAT ==> MachineFloat
 
-
-
   Exports == FortranMatrixCategory
 
   Implementation == add
 
+    real : UFST := ["real"::FST]$UFST
+
+    integer : UFST := ["integer"::FST]$UFST
+
+    syms : SYMTAB := empty()$SYMTAB
+
+    declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+
+    declare!(N,fortranInteger(),syms)$SYMTAB
+
+    declare!(LRWORK,fortranInteger(),syms)$SYMTAB
+
+    declare!(LIWORK,fortranInteger(),syms)$SYMTAB
+
+    zType : FT := construct(real,[N],false)$FT
+
+    declare!(Z,zType,syms)$SYMTAB
+
+    declare!(W,zType,syms)$SYMTAB
+
+    rType : FT := construct(real,[LRWORK],false)$FT
+
+    declare!(RWORK,rType,syms)$SYMTAB
+
+    iType : FT := construct(integer,[LIWORK],false)$FT
+
+    declare!(IWORK,iType,syms)$SYMTAB
+
+    Rep := FortranProgram(name,real,
+                          [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms)
+
+    -- To help the poor old compiler!
+    localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT)
+
+    coerce (u:MAT MFLOAT):$ ==
+      Ws: Symbol := W
+      Zs: Symbol := Z
+      code : List FC
+      l:EXPR MFLOAT := "+"/ _
+          [("+"/[localCoerce(elt(Ws,[j::O])$Symbol) * u(j,i)_
+                                              for j in 1..nrows(u)::PI])_
+           *localCoerce(elt(Zs,[i::O])$Symbol) for i in 1..ncols(u)::PI]
+      c := assign(name,l)$FC
+      code := [c,returns()]$List(FC)
+      code::$
+
+    coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+    coerce(r:RSFC):$ == coerce(r)$Rep
+
+    coerce(c:FortranCode):$ == coerce(c)$Rep
+
+    coerce(u:$):OutputForm == coerce(u)$Rep
+
+    outputAsFortran(u):Void ==
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
+
+\end{chunk}
+
+\begin{chunk}{COQ ASP27}
+(* domain ASP27 *)
+(*
 
     real : UFST := ["real"::FST]$UFST
+
     integer : UFST := ["integer"::FST]$UFST
+
     syms : SYMTAB := empty()$SYMTAB
+
     declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+
     declare!(N,fortranInteger(),syms)$SYMTAB
+
     declare!(LRWORK,fortranInteger(),syms)$SYMTAB
+
     declare!(LIWORK,fortranInteger(),syms)$SYMTAB
+
     zType : FT := construct(real,[N],false)$FT
+
     declare!(Z,zType,syms)$SYMTAB
+
     declare!(W,zType,syms)$SYMTAB
+
     rType : FT := construct(real,[LRWORK],false)$FT
+
     declare!(RWORK,rType,syms)$SYMTAB
+
     iType : FT := construct(integer,[LIWORK],false)$FT
+
     declare!(IWORK,iType,syms)$SYMTAB
+
     Rep := FortranProgram(name,real,
                           [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms)
 
     -- To help the poor old compiler!
+    localCoerce : Symbol -> EXPR(MFLOAT)
     localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT)
 
+    coerce : Matrix(MachineFloat) -> %
     coerce (u:MAT MFLOAT):$ ==
       Ws: Symbol := W
       Zs: Symbol := Z
@@ -8171,26 +10017,35 @@ Asp27(name): Exports == Implementation where
       code := [c,returns()]$List(FC)
       code::$
 
+    coerce : List(FortranCode) -> %
     coerce(c:List FortranCode):$ == coerce(c)$Rep
 
+    coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
     coerce(r:RSFC):$ == coerce(r)$Rep
 
+    coerce : FortranCode -> %
     coerce(c:FortranCode):$ == coerce(c)$Rep
 
+    coerce : % -> OutputForm
     coerce(u:$):OutputForm == coerce(u)$Rep
 
+    outputAsFortran : % -> Void
     outputAsFortran(u):Void ==
       p := checkPrecision()$NAGLinkSupportPackage
       outputAsFortran(u)$Rep
       p => restorePrecision()$NAGLinkSupportPackage
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{ASP27.dotabb}
 "ASP27" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP27"]
 "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
 "ASP27" -> "ALIST"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP28 Asp28}
 
@@ -8535,26 +10390,101 @@ Asp28(name): Exports == Implementation where
 
   Implementation == add
 
+    real : UFST := ["real"::FST]$UFST
+
+    syms : SYMTAB := empty()
+
+    declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+
+    declare!(N,fortranInteger(),syms)$SYMTAB
+
+    declare!(LRWORK,fortranInteger(),syms)$SYMTAB
+
+    declare!(LIWORK,fortranInteger(),syms)$SYMTAB
+
+    xType : FT := construct(real,[N],false)$FT
+
+    declare!(Z,xType,syms)$SYMTAB
+
+    declare!(W,xType,syms)$SYMTAB
+
+    rType : FT := construct(real,[LRWORK],false)$FT
+
+    declare!(RWORK,rType,syms)$SYMTAB
+
+    iType : FT := construct(real,[LIWORK],false)$FT
+
+    declare!(IWORK,rType,syms)$SYMTAB
+
+    Rep := FortranProgram(name,["void"]$UFST,
+                          [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms)
+
+    -- To help the poor old compiler!
+    localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT)
+
+    coerce (u:MAT MFLOAT):$ ==
+      Zs: Symbol := Z
+      code : List FC
+      r: List EXPR MFLOAT
+      r := ["+"/[u(j,i)*localCoerce(elt(Zs,[i::OutputForm])$Symbol)_
+                         for i in 1..ncols(u)$MAT(MFLOAT)::PI]_
+                         for j in 1..nrows(u)$MAT(MFLOAT)::PI]
+      code := [assign(W@Symbol,vector(r)$VEC(EXPR MFLOAT)),returns()]$List(FC)
+      code::$
+
+    coerce(c:FortranCode):$ == coerce(c)$Rep
+
+    coerce(r:RSFC):$ == coerce(r)$Rep
+
+    coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+    coerce(u:$):OutputForm == coerce(u)$Rep
+
+    outputAsFortran(u):Void ==
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
+
+\end{chunk}
+
+\begin{chunk}{COQ ASP28}
+(* domain ASP28 *)
+(*
 
     real : UFST := ["real"::FST]$UFST
+
     syms : SYMTAB := empty()
+
     declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+
     declare!(N,fortranInteger(),syms)$SYMTAB
+
     declare!(LRWORK,fortranInteger(),syms)$SYMTAB
+
     declare!(LIWORK,fortranInteger(),syms)$SYMTAB
+
     xType : FT := construct(real,[N],false)$FT
+
     declare!(Z,xType,syms)$SYMTAB
+
     declare!(W,xType,syms)$SYMTAB
+
     rType : FT := construct(real,[LRWORK],false)$FT
+
     declare!(RWORK,rType,syms)$SYMTAB
+
     iType : FT := construct(real,[LIWORK],false)$FT
+
     declare!(IWORK,rType,syms)$SYMTAB
+
     Rep := FortranProgram(name,["void"]$UFST,
                           [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms)
 
     -- To help the poor old compiler!
+    localCoerce : Symbol -> EXPR(MFLOAT)
     localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT)
 
+    coerce : Matrix(MachineFloat) -> %
     coerce (u:MAT MFLOAT):$ ==
       Zs: Symbol := Z
       code : List FC
@@ -8565,26 +10495,35 @@ Asp28(name): Exports == Implementation where
       code := [assign(W@Symbol,vector(r)$VEC(EXPR MFLOAT)),returns()]$List(FC)
       code::$
 
+    coerce : FortranCode -> %
     coerce(c:FortranCode):$ == coerce(c)$Rep
 
+    coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
     coerce(r:RSFC):$ == coerce(r)$Rep
 
+    coerce : List(FortranCode) -> %
     coerce(c:List FortranCode):$ == coerce(c)$Rep
 
+    coerce : % -> OutputForm
     coerce(u:$):OutputForm == coerce(u)$Rep
 
+    outputAsFortran : % -> Void
     outputAsFortran(u):Void ==
       p := checkPrecision()$NAGLinkSupportPackage
       outputAsFortran(u)$Rep
       p => restorePrecision()$NAGLinkSupportPackage
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{ASP28.dotabb}
 "ASP28" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP28"]
 "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
 "ASP28" -> "ALIST"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP29 Asp29}
 
@@ -8690,16 +10629,27 @@ Asp29(name): Exports == Implementation where
     import SYMTAB
 
     real : FSTU := ["real"::FST]$FSTU
+
     integer : FSTU := ["integer"::FST]$FSTU
+
     syms : SYMTAB := empty()
+
     declare!(ISTATE,fortranInteger(),syms)
+
     declare!(NEXTIT,fortranInteger(),syms)    
+
     declare!(NEVALS,fortranInteger(),syms)
+
     declare!(NVECS,fortranInteger(),syms)
+
     declare!(K,fortranInteger(),syms)
+
     kType : FT := construct(real,[K],false)$FT
+
     declare!(F,kType,syms)
+
     declare!(D,kType,syms)
+
     Rep := FortranProgram(name,["void"]$FSTU,
                           [ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D],syms)
 
@@ -8710,12 +10660,58 @@ Asp29(name): Exports == Implementation where
       outputAsFortran(coerce(code)@Rep)$Rep
 
 \end{chunk}
+
+\begin{chunk}{COQ ASP29}
+(* domain ASP29 *)
+(*
+
+    import FST
+    import FT
+    import FC    
+    import SYMTAB
+
+    real : FSTU := ["real"::FST]$FSTU
+
+    integer : FSTU := ["integer"::FST]$FSTU
+
+    syms : SYMTAB := empty()
+
+    declare!(ISTATE,fortranInteger(),syms)
+
+    declare!(NEXTIT,fortranInteger(),syms)    
+
+    declare!(NEVALS,fortranInteger(),syms)
+
+    declare!(NVECS,fortranInteger(),syms)
+
+    declare!(K,fortranInteger(),syms)
+
+    kType : FT := construct(real,[K],false)$FT
+
+    declare!(F,kType,syms)
+
+    declare!(D,kType,syms)
+
+    Rep := FortranProgram(name,["void"]$FSTU,
+                          [ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D],syms)
+
+    outputAsFortran : () -> Void
+    outputAsFortran():Void ==
+      callOne := call("F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D)")
+      code : List FC := [callOne,returns()]$List(FC)
+      outputAsFortran(coerce(code)@Rep)$Rep
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ASP29.dotabb}
 "ASP29" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP29"]
 "FORTCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FORTCAT"]
 "ASP29" -> "FORTCAT"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP30 Asp30}
 
@@ -8879,22 +10875,39 @@ Asp30(name): Exports == Implementation where
     import Switch
 
     real : UFST := ["real"::FST]$UFST
+
     integer : UFST := ["integer"::FST]$UFST
+
     syms : SYMTAB := empty()$SYMTAB
+
     declare!(MODE,fortranInteger()$FT,syms)$SYMTAB
+
     declare!(M,fortranInteger()$FT,syms)$SYMTAB
+
     declare!(N,fortranInteger()$FT,syms)$SYMTAB
+
     declare!(LRWORK,fortranInteger()$FT,syms)$SYMTAB
+
     declare!(LIWORK,fortranInteger()$FT,syms)$SYMTAB
+
     xType : FT := construct(real,[N],false)$FT
+
     declare!(X,xType,syms)$SYMTAB
+
     yType : FT := construct(real,[M],false)$FT
+
     declare!(Y,yType,syms)$SYMTAB
+
     rType : FT := construct(real,[LRWORK],false)$FT
+
     declare!(RWORK,rType,syms)$SYMTAB
+
     iType : FT := construct(integer,[LIWORK],false)$FT
+
     declare!(IWORK,iType,syms)$SYMTAB
+
     declare!(IFAIL,fortranInteger()$FT,syms)$SYMTAB
+
     Rep := FortranProgram(name,["void"]$UFST,
                           [MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms)
 
@@ -8929,12 +10942,99 @@ Asp30(name): Exports == Implementation where
       p => restorePrecision()$NAGLinkSupportPackage
 
 \end{chunk}
+
+\begin{chunk}{COQ ASP30}
+(* domain ASP30 *)
+(*
+
+    import FC    
+    import FT    
+    import Switch
+
+    real : UFST := ["real"::FST]$UFST
+
+    integer : UFST := ["integer"::FST]$UFST
+
+    syms : SYMTAB := empty()$SYMTAB
+
+    declare!(MODE,fortranInteger()$FT,syms)$SYMTAB
+
+    declare!(M,fortranInteger()$FT,syms)$SYMTAB
+
+    declare!(N,fortranInteger()$FT,syms)$SYMTAB
+
+    declare!(LRWORK,fortranInteger()$FT,syms)$SYMTAB
+
+    declare!(LIWORK,fortranInteger()$FT,syms)$SYMTAB
+
+    xType : FT := construct(real,[N],false)$FT
+
+    declare!(X,xType,syms)$SYMTAB
+
+    yType : FT := construct(real,[M],false)$FT
+
+    declare!(Y,yType,syms)$SYMTAB
+
+    rType : FT := construct(real,[LRWORK],false)$FT
+
+    declare!(RWORK,rType,syms)$SYMTAB
+
+    iType : FT := construct(integer,[LIWORK],false)$FT
+
+    declare!(IWORK,iType,syms)$SYMTAB
+
+    declare!(IFAIL,fortranInteger()$FT,syms)$SYMTAB
+
+    Rep := FortranProgram(name,["void"]$UFST,
+                          [MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms)
+
+    coerce : Matrix(MachineFloat) -> %
+    coerce(a:MAT MFLOAT):$ ==
+      locals : SYMTAB := empty()
+      numRows := nrows(a) :: Polynomial Integer
+      numCols := ncols(a) :: Polynomial Integer
+      declare!(A,[real,[numRows,numCols],false]$FT,locals)
+      declare!(F06PAF@S,construct(["void"]$UFST,[]@List(S),true)$FT,locals)
+      ptA:UEXPR := [("MODE"::S)::EXI]
+      ptB:UEXPR := [1::EXI]
+      ptC:UEXPR := [2::EXI]
+      sw1 : Switch := EQ(ptA,ptB)$Switch
+      sw2 : Switch := EQ(ptA,ptC)$Switch
+      callOne := call("F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1)")
+      callTwo := call("F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1)")
+      c : FC := cond(sw1,callOne,cond(sw2,callTwo))
+      code : List FC := [assign(A,a),c,returns()]
+      ([locals,code]$RSFC)::$
+
+    coerce : List(FortranCode) -> %
+    coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+    coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
+    coerce(r:RSFC):$ == coerce(r)$Rep
+
+    coerce : FortranCode -> %
+    coerce(c:FortranCode):$ == coerce(c)$Rep
+
+    coerce : % -> OutputForm
+    coerce(u:$):OutputForm == coerce(u)$Rep
+
+    outputAsFortran : % -> Void          
+    outputAsFortran(u):Void ==
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ASP30.dotabb}
 "ASP30" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP30"]
 "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
 "ASP30" -> "ALIST"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP31 Asp31}
 
@@ -9063,8 +11163,6 @@ Asp31(name): Exports == Implementation where
   MF2    ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR,
                     EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT)
 
-
-
   Exports ==> FortranVectorFunctionCategory with
     coerce : VEC FEXPR -> $
       ++coerce(f) takes objects from the appropriate instantiation of
@@ -9072,21 +11170,137 @@ Asp31(name): Exports == Implementation where
 
   Implementation ==> add
 
+    real : UFST := ["real"::FST]$UFST
+
+    syms : SYMTAB := empty()
+
+    declare!(X,fortranReal(),syms)$SYMTAB
+
+    yType : FT := construct(real,["*"::Symbol],false)$FT
+
+    declare!(Y,yType,syms)$SYMTAB
+
+    Rep := FortranProgram(name,["void"]$UFST,[X,Y,PW],syms)
+
+    -- To help the poor old compiler!
+    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+    localAssign(s:Symbol,j:MAT FEXPR):FC ==
+      j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2
+      assign(s,j')$FC
+
+    makeXList(n:Integer):List(Symbol) ==
+      j:Integer
+      y:Symbol := Y::Symbol
+      p:List(Symbol) := []
+      for j in 1 .. n repeat p:= cons(subscript(y,[j::OutputForm])$Symbol,p)
+      p:= reverse(p)
+
+    coerce(u:VEC FEXPR):$ == 
+      dimension := #u::Polynomial Integer
+      locals : SYMTAB := empty()
+      declare!(PW,[real,[dimension,dimension],false]$FT,locals)$SYMTAB
+      n:Integer := maxIndex(u)$VEC(FEXPR)
+      p:List(Symbol) := makeXList(n)
+      jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_
+                                     Symbol,FEXPR ,VEC FEXPR,List(Symbol))
+      code : List FC := [localAssign(PW,jac),returns()$FC]$List(FC)
+      ([locals,code]$RSFC)::$
+
+    retract(u:VEC FRAC POLY INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+      v::$
 
+    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract(u:VEC FRAC POLY FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v::$
+
+    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=_
+        map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract(u:VEC EXPR INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+      v::$
+
+    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract(u:VEC EXPR FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+      v::$
+
+    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract(u:VEC POLY INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+      v::$
+
+    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract(u:VEC POLY FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+      v::$
+
+    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    coerce(c:List FC):$ == coerce(c)$Rep
+
+    coerce(r:RSFC):$ == coerce(r)$Rep
+
+    coerce(c:FC):$ == coerce(c)$Rep
+
+    coerce(u:$):O == coerce(u)$Rep
+
+    outputAsFortran(u):Void ==
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
+
+\end{chunk}
+
+\begin{chunk}{COQ ASP31}
+(* domain ASP31 *)
+(*
     real : UFST := ["real"::FST]$UFST
+
     syms : SYMTAB := empty()
+
     declare!(X,fortranReal(),syms)$SYMTAB
+
     yType : FT := construct(real,["*"::Symbol],false)$FT
+
     declare!(Y,yType,syms)$SYMTAB
+
     Rep := FortranProgram(name,["void"]$UFST,[X,Y,PW],syms)
 
     -- To help the poor old compiler!
     fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
 
+    localAssign : (Symbol, MAT FEXPR) -> FC
     localAssign(s:Symbol,j:MAT FEXPR):FC ==
       j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2
       assign(s,j')$FC
 
+    makeXList : Integer -> List(Symbol)
     makeXList(n:Integer):List(Symbol) ==
       j:Integer
       y:Symbol := Y::Symbol
@@ -9094,6 +11308,8 @@ Asp31(name): Exports == Implementation where
       for j in 1 .. n repeat p:= cons(subscript(y,[j::OutputForm])$Symbol,p)
       p:= reverse(p)
 
+    coerce : Vector(FortranExpression([construct,QUOTEX],
+                                      [construct,QUOTEY],MachineFloat)) -> %
     coerce(u:VEC FEXPR):$ == 
       dimension := #u::Polynomial Integer
       locals : SYMTAB := empty()
@@ -9105,80 +11321,102 @@ Asp31(name): Exports == Implementation where
       code : List FC := [localAssign(PW,jac),returns()$FC]$List(FC)
       ([locals,code]$RSFC)::$
 
+    retract : Vector(Fraction(Polynomial(Integer))) -> %
     retract(u:VEC FRAC POLY INT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Fraction(Polynomial(Integer))) -> Union(%,"failed")
     retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
       v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+    retract : Vector(Fraction(Polynomial(Float))) -> %
     retract(u:VEC FRAC POLY FLOAT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Fraction(Polynomial(Float))) -> Union(%,"failed")
     retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
-      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v:Union(VEC FEXPR,"failed"):=_
+        map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+    retract : Vector(Expression(Integer)) -> %
     retract(u:VEC EXPR INT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Expression(Integer)) -> Union(%,"failed")
     retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
       v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+    retract : Vector(Expression(Float)) -> %
     retract(u:VEC EXPR FLOAT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Expression(Float)) -> Union(%,"failed")
     retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
       v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+    retract : Vector(Polynomial(Integer)) -> %
     retract(u:VEC POLY INT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Polynomial(Integer)) -> Union(%,"failed")
     retractIfCan(u:VEC POLY INT):Union($,"failed") ==
       v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+    retract : Vector(Polynomial(Float)) -> %
     retract(u:VEC POLY FLOAT):$ ==
       v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
       v::$
 
+    retractIfCan : Vector(Polynomial(Float)) -> Union(%,"failed")
     retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
       v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
+    coerce : List(FortranCode) -> %
     coerce(c:List FC):$ == coerce(c)$Rep
 
+    coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
     coerce(r:RSFC):$ == coerce(r)$Rep
 
+    coerce : FortranCode -> %
     coerce(c:FC):$ == coerce(c)$Rep
 
+    coerce : % -> OutputForm
     coerce(u:$):O == coerce(u)$Rep
 
+    outputAsFortran : % -> Void
     outputAsFortran(u):Void ==
       p := checkPrecision()$NAGLinkSupportPackage
       outputAsFortran(u)$Rep
       p => restorePrecision()$NAGLinkSupportPackage
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{ASP31.dotabb}
 "ASP31" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP31"]
 "FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
 "ASP31" -> "FS"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP33 Asp33}
 
@@ -9268,27 +11506,66 @@ Asp33(name): Exports == Implementation where
   Implementation ==> add
 
     real : UFST := ["real"::FST]$UFST
+
+    syms : SYMTAB := empty()
+
+    declare!(JINT,fortranInteger(),syms)$SYMTAB
+
+    declare!(X,fortranReal(),syms)$SYMTAB
+
+    vType : FT := construct(real,["3"::Symbol],false)$FT
+
+    declare!(V,vType,syms)$SYMTAB
+
+    Rep := FortranProgram(name,["void"]$UFST,[X,V,JINT],syms)
+
+    outputAsFortran():Void == 
+      outputAsFortran( (returns()$FortranCode)::Rep )$Rep
+
+    outputAsFortran(u):Void == outputAsFortran(u)$Rep
+
+    coerce(u:$):OutputForm == coerce(u)$Rep
+
+\end{chunk}
+
+\begin{chunk}{COQ ASP33}
+(* domain ASP33 *)
+(*
+    real : UFST := ["real"::FST]$UFST
+
     syms : SYMTAB := empty()
+
     declare!(JINT,fortranInteger(),syms)$SYMTAB
+
     declare!(X,fortranReal(),syms)$SYMTAB
+
     vType : FT := construct(real,["3"::Symbol],false)$FT
+
     declare!(V,vType,syms)$SYMTAB
+
     Rep := FortranProgram(name,["void"]$UFST,[X,V,JINT],syms)
 
+    outputAsFortran : () -> Void
     outputAsFortran():Void == 
       outputAsFortran( (returns()$FortranCode)::Rep )$Rep
 
+    outputAsFortran : % -> Void
     outputAsFortran(u):Void == outputAsFortran(u)$Rep
 
+    coerce : % -> OutputForm
     coerce(u:$):OutputForm == coerce(u)$Rep
 
+*)
+
 \end{chunk}
+
 \begin{chunk}{ASP33.dotabb}
 "ASP33" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP33"]
 "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
 "ASP33" -> "ALIST"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP34 Asp34}
 
@@ -9405,19 +11682,33 @@ Asp34(name): Exports == Implementation where
   Implementation == add
 
     real : UFST := ["real"::FST]$UFST
+
     integer : UFST := ["integer"::FST]$UFST
+
     syms : SYMTAB := empty()$SYMTAB
+
     declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+
     declare!(N,fortranInteger(),syms)$SYMTAB
+
     xType : FT := construct(real,[N],false)$FT
+
     declare!(X,xType,syms)$SYMTAB
+
     declare!(Y,xType,syms)$SYMTAB
+
     declare!(LRWORK,fortranInteger(),syms)$SYMTAB
+
     declare!(LIWORK,fortranInteger(),syms)$SYMTAB
+
     rType : FT := construct(real,[LRWORK],false)$FT
+
     declare!(RWORK,rType,syms)$SYMTAB
+
     iType : FT := construct(integer,[LIWORK],false)$FT
+
     declare!(IWORK,iType,syms)$SYMTAB
+
     Rep := FortranProgram(name,["void"]$UFST,
                           [IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms)
 
@@ -9453,6 +11744,84 @@ Asp34(name): Exports == Implementation where
       p => restorePrecision()$NAGLinkSupportPackage
 
 \end{chunk}
+
+\begin{chunk}{COQ ASP34}
+(* domain ASP34 *)
+(*
+
+    real : UFST := ["real"::FST]$UFST
+
+    integer : UFST := ["integer"::FST]$UFST
+
+    syms : SYMTAB := empty()$SYMTAB
+
+    declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+
+    declare!(N,fortranInteger(),syms)$SYMTAB
+
+    xType : FT := construct(real,[N],false)$FT
+
+    declare!(X,xType,syms)$SYMTAB
+
+    declare!(Y,xType,syms)$SYMTAB
+
+    declare!(LRWORK,fortranInteger(),syms)$SYMTAB
+
+    declare!(LIWORK,fortranInteger(),syms)$SYMTAB
+
+    rType : FT := construct(real,[LRWORK],false)$FT
+
+    declare!(RWORK,rType,syms)$SYMTAB
+
+    iType : FT := construct(integer,[LIWORK],false)$FT
+
+    declare!(IWORK,iType,syms)$SYMTAB
+
+    Rep := FortranProgram(name,["void"]$UFST,
+                          [IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms)
+
+    -- To help the poor old compiler
+    localAssign : (Symbol,EXI) -> FC
+    localAssign(s:Symbol,u:EXI):FC == assign(s,u)$FC
+
+    coerce : Matrix(MachineFloat) -> %
+    coerce(u:Matrix MachineFloat):$ == 
+      dimension := nrows(u) ::Polynomial Integer
+      locals : SYMTAB := empty()$SYMTAB
+      declare!(I,fortranInteger(),syms)$SYMTAB
+      declare!(J,fortranInteger(),syms)$SYMTAB
+      declare!(W1,[real,[dimension],false]$FT,locals)$SYMTAB
+      declare!(W2,[real,[dimension],false]$FT,locals)$SYMTAB
+      declare!(MS,[real,[dimension,dimension],false]$FT,locals)$SYMTAB
+      assign1 : FC := localAssign(IFLAG@Symbol,(-1)@EXI)
+      call : FC := call("F04ASF(MS,N,X,N,Y,W1,W2,IFLAG)")$FC
+      assign2 : FC := localAssign(IFLAG::Symbol,-(IFLAG@Symbol::EXI))
+      assign3 : FC := assign(MS,u)$FC
+      code : List FC := [assign1,assign3,call,assign2,returns()]$List(FC)
+      ([locals,code]$RSFC)::$
+
+    coerce : List(FortranCode) -> %
+    coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+    coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
+    coerce(r:RSFC):$ == coerce(r)$Rep
+
+    coerce : FortranCode -> %
+    coerce(c:FortranCode):$ == coerce(c)$Rep
+
+    coerce : % -> OutputForm
+    coerce(u:$):OutputForm == coerce(u)$Rep
+
+    outputAsFortran : % -> Void
+    outputAsFortran(u):Void ==
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ASP34.dotabb}
 "ASP34" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP34"]
 "FIELD"  [color="#4488FF",href="bookvol10.2.pdf#nameddest=FIELD"]
@@ -9461,6 +11830,7 @@ Asp34(name): Exports == Implementation where
 "ASP34" -> "RADCAT"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP35 Asp35}
 
@@ -9597,7 +11967,7 @@ Asp35(name): Exports == Implementation where
   MFLOAT ==> MachineFloat
   FEXPR  ==> FortranExpression([],['X],MFLOAT)
   MF2    ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR,
-                    EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT)
+                   EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT)
   SWU    ==> Union(I:Expression Integer,F:Expression Float,
                    CF:Expression Complex Float,switch:Switch)
 
@@ -9609,15 +11979,25 @@ Asp35(name): Exports == Implementation where
   Implementation ==> add
 
     real : UFST := ["real"::FST]$UFST
+
     syms : SYMTAB := empty()$SYMTAB
+
     declare!(N,fortranInteger(),syms)$SYMTAB
+
     xType : FT := construct(real,[N],false)$FT
+
     declare!(X,xType,syms)$SYMTAB
+
     declare!(FVEC,xType,syms)$SYMTAB
+
     declare!(LDFJAC,fortranInteger(),syms)$SYMTAB
+
     jType : FT := construct(real,[LDFJAC,N],false)$FT
+
     declare!(FJAC,jType,syms)$SYMTAB
+
     declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+
     Rep := FortranProgram(name,["void"]$UFST,[N,X,FVEC,FJAC,LDFJAC,IFLAG],syms)
 
     coerce(u:$):OutputForm == coerce(u)$Rep
@@ -9673,7 +12053,8 @@ Asp35(name): Exports == Implementation where
       v::$
 
     retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
-      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v:Union(VEC FEXPR,"failed"):=_
+        map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
       v case "failed" => "failed"
       (v::VEC FEXPR)::$
 
@@ -9714,12 +12095,160 @@ Asp35(name): Exports == Implementation where
       (v::VEC FEXPR)::$
 
 \end{chunk}
+
+\begin{chunk}{COQ ASP35}
+(* domain ASP35 *)
+(*
+    real : UFST := ["real"::FST]$UFST
+
+    syms : SYMTAB := empty()$SYMTAB
+
+    declare!(N,fortranInteger(),syms)$SYMTAB
+
+    xType : FT := construct(real,[N],false)$FT
+
+    declare!(X,xType,syms)$SYMTAB
+
+    declare!(FVEC,xType,syms)$SYMTAB
+
+    declare!(LDFJAC,fortranInteger(),syms)$SYMTAB
+
+    jType : FT := construct(real,[LDFJAC,N],false)$FT
+
+    declare!(FJAC,jType,syms)$SYMTAB
+
+    declare!(IFLAG,fortranInteger(),syms)$SYMTAB
+
+    Rep := FortranProgram(name,["void"]$UFST,[N,X,FVEC,FJAC,LDFJAC,IFLAG],syms)
+
+    coerce : % -> OutputForm
+    coerce(u:$):OutputForm == coerce(u)$Rep
+
+    makeXList : Integer -> List(Symbol)
+    makeXList(n:Integer):List(Symbol) ==
+      x:Symbol := X::Symbol
+      [subscript(x,[j::OutputForm])$Symbol for j in 1..n]
+
+    fexpr2expr : FEXPR -> EXPR MFLOAT
+    fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR
+
+    localAssign1 : (Symbol,MAT FEXPR) -> FC
+    localAssign1(s:Symbol,j:MAT FEXPR):FC ==
+      j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2
+      assign(s,j')$FC
+
+    localAssign2 : (Symbol,VEC FEXPR) -> FC
+    localAssign2(s:Symbol,j:VEC FEXPR):FC ==
+      j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT)
+      assign(s,j')$FC
+
+    coerce : Vector(FortranExpression([construct],
+                                      [construct,QUOTEX],MachineFloat)) -> %
+    coerce(u:VEC FEXPR):$ ==
+      n:Integer := maxIndex(u)
+      p:List(Symbol) := makeXList(n)
+      jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_
+                                         Symbol,FEXPR,VEC FEXPR,List(Symbol))
+      assf:FC := localAssign2(FVEC,u)
+      assj:FC := localAssign1(FJAC,jac)
+      iflag:SWU := [IFLAG@Symbol::EXPR(INT)]$SWU
+      sw1:Switch := EQ(iflag,[1::EXPR(INT)]$SWU)
+      sw2:Switch := EQ(iflag,[2::EXPR(INT)]$SWU)
+      cond(sw1,assf,cond(sw2,assj)$FC)$FC::$
+
+    coerce : List(FortranCode) -> %
+    coerce(c:List FC):$ == coerce(c)$Rep
+
+    coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
+    coerce(r:RSFC):$ == coerce(r)$Rep
+
+    coerce : FortranCode -> %
+    coerce(c:FC):$ == coerce(c)$Rep
+
+    outputAsFortran : % -> Void
+    outputAsFortran(u):Void ==
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
+
+    retract : Vector(Fraction(Polynomial(Integer))) -> %
+    retract(u:VEC FRAC POLY INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Fraction(Polynomial(Integer))) -> Union(%,"failed")
+    retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract : Vector(Fraction(Polynomial(Float))) -> %
+    retract(u:VEC FRAC POLY FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Fraction(Polynomial(Float))) -> Union(%,"failed")
+    retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=_
+        map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract : Vector(Expression(Integer)) -> %
+    retract(u:VEC EXPR INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Expression(Integer)) -> Union(%,"failed")
+    retractIfCan(u:VEC EXPR INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract : Vector(Expression(Float)) -> %
+    retract(u:VEC EXPR FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Expression(Float)) -> Union(%,"failed")
+    retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract : Vector(Polynomial(Integer)) -> %
+    retract(u:VEC POLY INT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Polynomial(Integer)) -> Union(%,"failed")
+    retractIfCan(u:VEC POLY INT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+    retract : Vector(Polynomial(Float)) -> %
+    retract(u:VEC POLY FLOAT):$ ==
+      v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR)
+      v::$
+
+    retractIfCan : Vector(Polynomial(Float)) -> Union(%,"failed")
+    retractIfCan(u:VEC POLY FLOAT):Union($,"failed") ==
+      v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR)
+      v case "failed" => "failed"
+      (v::VEC FEXPR)::$
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ASP35.dotabb}
 "ASP35" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP35"]
 "FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
 "ASP35" -> "FS"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP4 Asp4}
 
@@ -9832,13 +12361,19 @@ Asp4(name): Exports == Implementation where
   Implementation ==> add
 
     real : FSTU := ["real"::FST]$FSTU
+
     syms : SYMTAB := empty()$SYMTAB
+
     declare!(NDIM,fortranInteger(),syms)$SYMTAB
+
     xType : FT := construct(real,[NDIM],false)$FT
+
     declare!(X,xType,syms)$SYMTAB
+
     Rep := FortranProgram(name,real,[NDIM,X],syms)
 
     retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
+
     retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
@@ -9846,6 +12381,7 @@ Asp4(name): Exports == Implementation where
       foo::FEXPR::$
 
     retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
+
     retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
@@ -9853,6 +12389,7 @@ Asp4(name): Exports == Implementation where
       foo::FEXPR::$
 
     retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
+
     retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
@@ -9860,6 +12397,7 @@ Asp4(name): Exports == Implementation where
       foo::FEXPR::$
 
     retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
+
     retractIfCan(u:EXPR INT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
@@ -9867,6 +12405,7 @@ Asp4(name): Exports == Implementation where
       foo::FEXPR::$
 
     retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
+
     retractIfCan(u:POLY FLOAT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
@@ -9874,6 +12413,7 @@ Asp4(name): Exports == Implementation where
       foo::FEXPR::$
 
     retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
+
     retractIfCan(u:POLY INT):Union($,"failed") ==
       foo : Union(FEXPR,"failed") 
       foo := retractIfCan(u)$FEXPR
@@ -9897,12 +12437,117 @@ Asp4(name): Exports == Implementation where
       p => restorePrecision()$NAGLinkSupportPackage
 
 \end{chunk}
+
+\begin{chunk}{COQ ASP4}
+(* domain ASP4 *)
+(*
+
+    real : FSTU := ["real"::FST]$FSTU
+
+    syms : SYMTAB := empty()$SYMTAB
+
+    declare!(NDIM,fortranInteger(),syms)$SYMTAB
+
+    xType : FT := construct(real,[NDIM],false)$FT
+
+    declare!(X,xType,syms)$SYMTAB
+
+    Rep := FortranProgram(name,real,[NDIM,X],syms)
+
+    retract : Fraction(Polynomial(Integer)) -> %
+    retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Fraction(Polynomial(Integer)) -> Union(%,"failed")
+    retractIfCan(u:FRAC POLY INT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      foo::FEXPR::$
+
+    retract : Fraction(Polynomial(Float)) -> %
+    retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Fraction(Polynomial(Float)) -> Union(%,"failed")
+    retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      foo::FEXPR::$
+
+    retract : Expression(Float) -> %
+    retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Expression(Float) -> Union(%,"failed")
+    retractIfCan(u:EXPR FLOAT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      foo::FEXPR::$
+
+    retract : Expression(Integer) -> %
+    retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Expression(Integer) -> Union(%,"failed")
+    retractIfCan(u:EXPR INT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      foo::FEXPR::$
+
+    retract : Polynomial(Float) -> %
+    retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Polynomial(Float) -> Union(%,"failed")
+    retractIfCan(u:POLY FLOAT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      foo::FEXPR::$
+
+    retract : Polynomial(Integer) -> %
+    retract(u:POLY INT):$ == (retract(u)@FEXPR)::$
+
+    retractIfCan : Polynomial(Integer) -> Union(%,"failed")
+    retractIfCan(u:POLY INT):Union($,"failed") ==
+      foo : Union(FEXPR,"failed") 
+      foo := retractIfCan(u)$FEXPR
+      foo case "failed" => "failed"
+      foo::FEXPR::$
+
+    coerce : FortranExpression([construct],
+                               [construct,QUOTEX],MachineFloat) -> %
+    coerce(u:FEXPR):$ ==
+      coerce((u::Expression(MachineFloat))$FEXPR)$Rep
+
+    coerce : List(FortranCode) -> %
+    coerce(c:List FortranCode):$ == coerce(c)$Rep
+
+    coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
+    coerce(r:RSFC):$ == coerce(r)$Rep
+
+    coerce : FortranCode -> %
+    coerce(c:FortranCode):$ == coerce(c)$Rep
+
+    coerce : % -> OutputForm
+    coerce(u:$):OutputForm == coerce(u)$Rep
+
+    outputAsFortran : % -> Void
+    outputAsFortran(u):Void ==
+      p := checkPrecision()$NAGLinkSupportPackage
+      outputAsFortran(u)$Rep
+      p => restorePrecision()$NAGLinkSupportPackage
+
+*)
+
+\end{chunk}
+
 \begin{chunk}{ASP4.dotabb}
 "ASP4" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ASP4"]
 "PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
 "ASP4" -> "PFECAT"
 
 \end{chunk}
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \section{domain ASP41 Asp41}
 
@@ -10067,7